Clipper On Line • Ver Tópico - Erro em ANNOUNCE RDDSYS / SQL

Erro em ANNOUNCE RDDSYS / SQL

Discussão sobre SQL

Moderador: Moderadores

 

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 24 Mai 2014 17:31

Pessoal,

Estou começando agora a usar MySQL em nuvem. Já consegui criar uma tabela e importar os dados do dbf para SQL usando o exemplo da dbf2mysq.prg.

Criei uma função simples para consulta da tabela, usando o modelo demo.prg que o Toledo postou no seu excelente tutorial. A função está assim:

#include "dbinfo.ch"
#define RDDI_CONNECT     1001
#define RDDI_DISCONNECT   1002
#define RDDI_EXECUTE     1003
ANNOUNCE RDDSYS
REQUEST SQLMIX, SDDODBC
Function Main()
         sqlagtc()
return nil

function sqlagtc
         LOCAL nConnection
         RDDSETDEFAULT( "SQLMIX" )
         nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.servidor.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=nomeuser;pwd=senha;database=nomedobd;" } )
         IF nConnection == 0
          if us="I"
               Alert("Erro na conexao com o servidor")
         endif
            Return .f.
         ENDIF
         DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
         INDEX ON FIELD->NOME TAG nome TO agtel
         GO TOP
         Browse()
         DBCLOSEALL()
Return .t.


Até aqui tudo certo.

Entretanto, quando tento colocar esta mesma função dentro de um programa que já tenho, dá um erro muito estranho. O erro é o seguinte:

Error DBCMD/1015  Erro nos parâmetros: DBUSEAREA


E está dando o erro na seguinte linha do meu programa:

use &nomebase. shared


O estranho é que essa linha do programa não tem nada a ver com a função nova. Está em outra função totalmente estranha a ela. E mais estranho é que o erro ocorre antes mesmo de eu chamar a função nova.

Fazendo testes, já descobri que o erro ocorre por causa da seguinte linha da função nova:

ANNOUNCE RDDSYS


Posso afirmar isso porque, quando tiro esta linha, não dá o erro acima citado (mas aí a função nova é que dá erro). Testei com todas as linhas da nova função, e só nesta é que dá erro.

Estou chamando esta função dentro do meu programa assim:

#include "inkey.ch"
#include "hbgtinfo.ch"
#include "dbinfo.ch"
#define RDDI_CONNECT     1001
#define RDDI_DISCONNECT   1002
#define RDDI_EXECUTE     1003
REQUEST SQLMIX, SDDODBC
ANNOUNCE RDDSYS
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
function main()
         HB_SETCODEPAGE('PT850')
         HB_LANGSELECT('PT')
...
...
function sqlagtc
         LOCAL nConnection
         RDDSETDEFAULT( "SQLMIX" )
         nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.servidor.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=nomeuser;pwd=senha;database=nomedobd;" } )
         IF nConnection == 0
          if us="I"
               Alert("Erro na conexao com o servidor")
         endif
            Return .f.
         ENDIF
         DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
         INDEX ON FIELD->NOME TAG nome TO agtel
         GO TOP
         Browse()
         DBCLOSEALL()
Return .t.


Pergunto: fiz alguma coisa errada? Ou existe alguma incompatibilidade entre esta nova função e o meu programa anterior?
Nota de Moderação:
Toledo: Mensagem editada para retirar o nome de usuário e senha real do servidor de MySQL. Por medida de segurança, evite postar nomes de usuários e senhas verdadeiras, pois o fórum tem livre acesso para qualquer visitante.
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 25 Mai 2014 11:49

Inácio, nunca poste em suas mensagens nome de usuário e senhas verdadeiras. Editei a sua mensagem, pois o fórum é aberto para qualquer visitante, então só espero que ninguém tenha anotado estes seus dados.

Agora sobre o seu código, tente o seguinte:

- No início do seu programa (depois de Func Main()) coloque: RDDSETDEFAULT( "DBF" )
- Na sua função sqlagtc() retire a linha: RDDSETDEFAULT( "SQLMIX" )
- Na função DBUSEAREA() que você vai usar para abrir as tabelas do banco de dados MySQL, informe o RDD que será usado. Por exemplo: DBUSEAREA( .T.,"SQLMIX", "SELECT * FROM agtel", "agtel" )

Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 25 Mai 2014 17:44

Desculpe, Toledo, esqueci.

É pra manter o ANNOUNCE RDDSYS? Quando eu mantenho ele, dá erro na linha do RDDSETDEFAULT("DBF"), logo no início do programa. Se eu tiro, daí a conexão ao banco de dados não funciona.
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 25 Mai 2014 18:26

cjp escreveu:É pra manter o ANNOUNCE RDDSYS?

Sim!

cjp escreveu:Quando eu mantenho ele, dá erro na linha do RDDSETDEFAULT("DBF")

Neste caso, alterar o comando REQUEST SQLMIX, SDDODBC por REQUEST SQLMIX, SDDODBC, _DBF.

Retorne também a sua função sqlagtc() como estava antes, mas com algumas alterações:

function sqlagtc
         LOCAL nConnection
         _rddantes:=RDDSETDEFAULT( "SQLMIX" )
         nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.servidor.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=nomeuser;pwd=senha;database=nomedobd;" } )
         IF nConnection == 0
          if us="I"
               Alert("Erro na conexao com o servidor")
         endif
            Return .f.
         ENDIF
         DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
         INDEX ON FIELD->NOME TAG nome TO agtel
         GO TOP
         Browse()
         DBCLOSEALL()
         RDDSETDEFAULT( _rddantes )
Return .t.


Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 25 Mai 2014 23:07

Não deu mais o erro no RDDSETDEFAULT, mas está dando o seguinte erro na conexão com o banco de dados:

Error SQLBASE/1901  Not connected


Não sei se estou falando besteira, e me desculpe pelo abuso de tentar te corrigir, mas não estaria errada a tua função na seguinte parte:

_rddantes:=RDDSETDEFAULT( "SQLMIX" )


Se eu entendi a tua lógica, a ideia aí seria salvar na variável _rddantes o default do RDD que estava em uso até abrir esta função, para depois restaurá-lo no final (RDDSETDEFAULT( _rddantes )), não é isso? Se for isso, então não teria que salvar o RDDSETDEFAULT("DBF") na variável?

Bom, foi realmente abuso de minha parte, pois testei fazer da forma como estou falando e também deu o mesmo erro.

Também testei assim:

function sqlagtc
    LOCAL nConnection
   RDDSETDEFAULT( "SQLMIX" )
    nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.xxxxxxxxxxx.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=xxxxxx;pwd=xxxxx;database=xxxxxx;" } )
    IF nConnection == 0
     if us="I"
       Alert("Erro na conexao com o servidor")
    endif
      Return .f.
    ENDIF
    DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
    INDEX ON FIELD->NOME TAG nome TO agtel
    GO TOP
    Browse()
    DBCLOSEALL()
    RDDSETDEFAULT("DBF")
Return .t.


Mas também está dando o mesmo erro. Então, não consigo entender o que está errado.
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 26 Mai 2014 11:08

cjp escreveu:Error SQLBASE/1901 Not connected

Você informou apenas a mensagem de erro, mas o mais importante é saber onde está ocorrendo o erro, em qual linha do seu código.

cjp escreveu:Se eu entendi a tua lógica, a ideia aí seria salvar na variável _rddantes o default do RDD que estava em uso até abrir esta função, para depois restaurá-lo no final (RDDSETDEFAULT( _rddantes )), não é isso? Se for isso, então não teria que salvar o RDDSETDEFAULT("DBF") na variável?

Sim, é isto mesmo. E da maneira que eu fiz está correta, pois a maioria das funções que vai setar (SET) uma determinada configuração, sempre retorna a configuração que está antes que a função é chamada (executada), que neste caso retorna o RDD DBF.

Bom, mas pela mensagem de erro, já dá para ter uma ideia de que a conexão com o banco de dados MySQL não foi realizada, então seria bom verificar se os dados (IP servidor, usuário, senha e nome do BD) para conexão estão corretos.
Provavelmente a conexão não ocorreu e a função sqlagtc() foi encerrada sem avisar o erro na conexão.

No seu código da função sqlagtc() você verifica se a conexão não foi feita (IF nConnection == 0), mas logo em seguida você valida uma variável us é igual a "I" para mostrar a mensagem "Erro na conexao com o servidor". O que eu acho é que a conexão com o MySQL não está ocorrendo e esta variável us deve ser diferente de "I" e não é apresentado a mensagem de erro na conexão. Ai a função é encerrada e retorna para o seu programa principal e em alguma parte dele ocorre o erro que você mencionou na sua mensagem anterior.

Eu não tinha notado esta possibilidade da conexão com o MySQL não ocorrer, então na função sqlagtc() tem que fazer mais uma pequena alteração:

function sqlagtc
         LOCAL nConnection
         _rddantes:=RDDSETDEFAULT( "SQLMIX" )
         nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.servidor.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=nomeuser;pwd=senha;database=nomedobd;" } )
         IF nConnection == 0
            if us="I"
               Alert("Erro na conexao com o servidor")
            endif
            RDDSETDEFAULT( _rddantes )
            Return .f.
         ENDIF
         DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
         INDEX ON FIELD->NOME TAG nome TO agtel
         GO TOP
         Browse()
         DBCLOSEALL()
         RDDSETDEFAULT( _rddantes )
Return .t.


Então, além da alteração da função acima, verifique se os dados para conexão com o MySQL estão corretos.

Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 26 Mai 2014 12:33

O erro começa na linha da conexão mesmo (nConnection := RDDINFO( RDDI_CONNECT, {...). Mas vc está certo de que realmente ele indica o erro em outra parte do programa. Por via das dúvidas, estou anexando aqui o log do erro inteiro:

Ocorreu o erro: Error SQLBASE/1901  Not connected
Data..........: 26/05/14
Hora..........: 12:23:23
M quina....: INACIO-CASA
Programa......: C:\agenda\AGENDA.EXE
Versão........: 21/11/12

Na função.....: DBUSEAREA
Na linha......: 0
No prg........:

Pasta.........: agenda
Usuário.......: I
Base em uso...:
Área em uso...: 4

Caminho Percorrido Antes do Erro:
Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: DBUSEAREA(0 - )

Vindo de......: USEBASE(18843 - COMUNS.PRG)

Vindo de......: MANDMAIL1(17592 - COMUNS.PRG)

Vindo de......: MANDER(724 - COMUNS.PRG)

Vindo de......: DEFERROR(335 - errors2.prg)

Vindo de......: (b)ERRORSYS(30 - errors2.prg)

Vindo de......: SQLAGTC(26523 - COMUNS.PRG)

Vindo de......: AGTEL(103 - agtel.prg)

Vindo de......: MAIN(272 - AGENDA.PRG)

Mem¢ria dispon¡vel para valores caracteres: 1292164
Maior bloco dispon¡vel para valores caracteres: 1292164
µrea dispon¡vel para comandos RUN: 1292164

V¡deo Screen Dump:
------------------------------------------------------------------------------------
|                                                                                                    |
|Aguarde                                                                                             |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
|                                                                                                    |
| Aguarde...                                                                                         |
|Aguarde                                                                                             |
---------------------------------------------------------------------------------



Para o caso de vc precisar, estou juntando aqui o arquivo errors2.prg, que é o errorsys.prg modificado por mim:

/***
*
*   Errorsys.prg
*
*  Standard Clipper error handler
*
*  Copyright (c) 1990-1993, Computer Associates International, Inc.
*  All rights reserved.
*
*  Compile:  /m /n /w
*
*/

#include "error.ch"

// put messages to STDERR
#command ?    =>  ?? Chr(13) + Chr(10) ; ??
#command ??   =>  OutErr()

// used below
#define NTRIM(n)      ( LTrim(Str(n)) )

/***
*   ErrorSys()
*
*   Note:  automatically executes at startup
*/

proc ErrorSys()
   ErrorBlock( {|e| DefError(e)} )
return

/***
*   DefError()
*/
static func DefError(e)
     LOCAL cScreen
local i, cMessage, aOptions, nChoice
     LOCAL nCount

   // by default, division by zero yields zero
   if ( e:genCode == EG_ZERODIV )
      return (0)
   end

   // for network open error, set NETERR() and subsystem default
   if ( e:genCode == EG_OPEN .and. e:osCode == 32 .and. e:canDefault )

      NetErr(.t.)
      return (.f.)                           // NOTE

   end

   // for lock error during APPEND BLANK, set NETERR() and subsystem default
   if ( e:genCode == EG_APPENDLOCK .and. e:canDefault )

      NetErr(.t.)
      return (.f.)                           // NOTE

   end

   // build error message
   cMessage := ErrorMessage(e)

   // build options array
   // aOptions := {"Break", "Quit"}
   aOptions := {"Quit"}

   if (e:canRetry)
      AAdd(aOptions, "Retry")
   end

   if (e:canDefault)
      AAdd(aOptions, "Default")
   end

   // put up alert box
   nChoice := 1
   while ( nChoice == 0 )

      if ( Empty(e:osCode) )
         nChoice := Alert( cMessage, aOptions )

      else
         nChoice := Alert( cMessage + ;
                     ";(DOS Error " + NTRIM(e:osCode) + ")", ;
                     aOptions )
      end

      if ( nChoice == NIL )
         exit
      end

   end
     cScreen := Savescreen()
     nCols := MaxCol()
     nRows := MaxRow()
     nStart      := 1

   if ( !Empty(nChoice) )

      // do as instructed
      if ( aOptions[nChoice] == "Break" )
         Break(e)

      elseif ( aOptions[nChoice] == "Retry" )
         return (.t.)

      elseif ( aOptions[nChoice] == "Default" )
         return (.f.)

      end

   end

   // display message and traceback
   if ( !Empty(e:osCode) )
      cMessage += " (DOS Error " + NTRIM(e:osCode) + ") "
   end

*   ? cMessage
*   i := 2
*   while ( !Empty(ProcName(i)) )
*      ? "Called from", Trim(ProcName(i)) + ;
*         "(" + NTRIM(ProcLine(i)) + ")  "
*
*      i++
*   end

*   LogError( oError )

   
******* minha funþÒo ******

*cls
*catch oErr
*?oErr:Subcode
*wait ""
/* Tratativa de erro fpt
*********************************************************************
?e:osCode
?type(e:osCode)
* ?ntrim(e:osCode)
* ?type(ntrim(e:osCode))
wait ""
* if ( Empty(e:osCode) ) .And. !Empty( e:filename )
  If "1010"$e:osCode //( NTRIM(e:osCode) == "1010" ) .And. ( ".FPT" $ Upper(e:filename) )
   cBuffer := If( File( "Registro.ERR" ), MemoRead( "Registro.ERR" ), "" )
   cBuffer += "Erro no Registro: " + NTRIM(Recn()) + Chr(13)+Chr(10)
   MemoWrit( "Registro.ERR", NTRIM(Recn()) )
   Return .t.
  Endi
* Endi
*********************************************************************

*/


if "CRIAۂO"$upper(cmessage) .or. "CREATE"$upper(cmessage) .or. "CORRUPTION"$upper(cmessage) .or. "OPEN ERROR"$upper(cmessage) .or. "ABERTURA"$upper(cmessage)
    if us="I"
      cls
      @ 5,1 say "Ver erro de abertura/cria‡Æo (ERRORS2 163): "
      @ 7,1 say cmessage
      if vzerr<2
         tone(261.7,33)
      endif
      wait ""
      wait ""
   endif
       cls
      vzerr++
      if usebase("\tarefas\numeros")=.t.
         if rlbs()=.t.
            repl errocreate with vzerr
        endif
      endif
      use
       if (e:canRetry)
         if vzerr=2 .or. int(vzerr/11)=vzerr/11
            mandmail1("","Retornou .t. no canRetry: "+cmessage+"; vzerr: "+alltrim(str(vzerr)))
        endif   
        if vzerr<50
            if usebase("\tarefas\numeros")=.t.
             if rlbs()
                  repl errocreate with 0
            endif
            endif
          use
          wait ""
             return (.t.)
        endif
      else
          mandmail1("","Retornou falso no canRetry: "+cmessage)      
      endif    
Endif


if "LEITURA"$upper(cmessage)
   @ maxrow()-2,1 clear to maxrow()-1,maxcol()-1
   @ maxrow()-1,1 say "H  um erro de leitura; aguarde tentativa de solu‡Æo"
   if us="I"
      @ 7,1 say cmessage
      if vzerr<2
         tone(261.7,33)
      endif
      wait ""
      wait ""
   endif
      vzerr++
      if usebase("\tarefas\numeros")=.t.
         if rlbs()=.t.
            repl errocreate with vzerr
        endif
      endif
      use
       if (e:canRetry)
         if vzerr=5 .or. int(vzerr/19)=vzerr/19
            mandmail1("","Retornou .t. no canRetry: "+cmessage+"; vzerr: "+alltrim(str(vzerr)))
        endif   
        if vzerr<40
            if usebase("\tarefas\numeros")=.t.
             if rlbs()=.t.
                  repl errocreate with 0
            endif
            endif
          use
          inkey(30)
          wait ""
             return (.t.)
        endif
        if vzerr>30 .and. "CONSULTA"$upper(cmessage)
           erase consulta.dbf
        endif
      else
          mandmail1("","Retornou falso no canRetry: "+cmessage)      
      endif    
Endif




*          FWriteLine( nHandle, Padr( Procname( nCount ), 21 ) + ' : ' + Transform( Procline( nCount ), "999,999" ) + " in Module: " + ProcFile( nCount ) )
*       FWriteLine( nHandle, 'Application name...: ' + hb_cmdargargv() )
*        FWriteLine( nHandle, 'Workstation name...: ' + netname() )


   /*
     Cria o log do erro e grava no arquivo error.Log
     Nota: A funÎ’o Hb_Eol(), coloca o 'End Off Line'
   */

   cMessage := "Ocorreu o erro: " + ansi(cMessage) + Hb_Eol()
   cMessage += "Data..........: "+dtoc(date())+ Hb_Eol()
   cMessage += "Hora..........: "+time() + Hb_Eol()
   cMessage += "M quina....: "+netname() + hb_eol()
   cMessage += "Programa......: " + Hb_CmdArgArgV() + Hb_Eol() //+ hb_eol()
   cMessage += ansi("VersÆo........: ") + vers + Hb_Eol() + Hb_Eol()
   cMessage += ansi("Na fun‡Æo.....: ") + ProcName(2) + Hb_Eol() //+ hb_eol()
   cMessage += "Na linha......: " + NTRIM(ProcLine(2)) + Hb_Eol() //+ hb_eol()
   cMessage += "No prg........: " + procfile(2) + Hb_Eol() + hb_eol()
   cMessage += "Pasta.........: " + CurDir() + Hb_Eol()
   cMessage += ansi("Usu rio.......: ") + us + Hb_Eol()
   cMessage += "Base em uso...: " + Alias() + Hb_Eol()
   cMessage += ansi("µrea em uso...: ") + alltrim(str(select())) + Hb_Eol()
*   cMessage += ansi("µrea 1........: ") + alias(1) + Hb_Eol()
   cMessage += if(!empty(alias(2)),ansi("µrea 2........: ") + alias(2) + Hb_Eol(),"")
   cMessage += if(!empty(alias(3)),ansi("µrea 3........: ") + alias(3) + Hb_Eol(),"")
   cMessage += if(!empty(alias(4)),ansi("µrea 4........: ") + alias(4) + Hb_Eol(),"")
   cMessage += if(!empty(alias(5)),ansi("µrea 5........: ") + alias(5) + Hb_Eol(),"")
   cMessage += if(!empty(alias(6)),ansi("µrea 6........: ") + alias(6) + Hb_Eol(),"")
   cMessage += if(!empty(alias(7)),ansi("µrea 7........: ") + alias(7) + Hb_Eol(),"")
   cMessage += if(!empty(alias(8)),ansi("µrea 8........: ") + alias(8) + Hb_Eol(),"")
   cMessage += if(!empty(alias(9)),ansi("µrea 9........: ") + alias(9) + Hb_Eol(),"")

   cMessage += Hb_Eol()
   cMessage += "Caminho Percorrido Antes do Erro:"  + Hb_Eol()
*  cMessage += Hb_Eol()

   i := 2
   While ( !Empty( ProcName(i) )) //.and. procname(i)#"MAIN" )
         cMessage += "Vindo de......: " + Trim(ProcName(i)) + "(" + NTRIM(ProcLine(i)) + " - " + procfile(i) + ")" + Hb_Eol() + hb_eol()
         i++
   EndDo
   
   cMessage += Hb_Eol()+"Mem¢ria dispon¡vel para valores caracteres: "+alltrim(str(memory(0)))
   cMessage += Hb_eol()+"Maior bloco dispon¡vel para valores caracteres: "+alltrim(str(memory(1)))
   cMessage += Hb_eol()+"µrea dispon¡vel para comandos RUN: "+alltrim(str(memory(2)))

   cMessage += Hb_Eol()
   cMessage += Hb_Eol()
*   cMessage += Hb_Eol()
*   cMessage += Hb_Eol()

         cMessage += "V¡deo Screen Dump:" + Hb_Eol()
           cMessage += Replicate( '-', nCols -15 ) + Hb_Eol()
           nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
           nRange := ( nCols + 1 ) * nCellSize
           For nCount := 1 To nRows + 1
               cOutString := ''
               cSubString := Substr( cScreen, nStart, nRange )
               For nForLoop := 1 To nRange step nCellSize
                   cOutString += Substr( cSubString, nForLoop, 1 )
               Next
            cMessage += "|" + cOutString + "|" + Hb_Eol()
               nStart += nRange
           Next
           cMessage += Replicate( '-', nCols -18 ) + Hb_Eol()
   Use
   Ferase( "error.log")
   MemoWrit( "error.log", cMessage )

if at("TAR2P",upper(hb_progname()))=0  .and. at("CRIANCAS",upper(hb_progname()))=0
   close all
   Alert( "Ocorreu um erro no programa, que ser  informado automaticamente ao Dr. Inacio. O programa ser  reiniciado na versÆo anterior. Vocˆ pode prosseguir usando o programa normalmente.") // C¢digo do erro (para uso do Dr. Inacio): "+procname(2)+"("+alltrim(str(procline(2)))+"); "+procname(3)+"("+alltrim(str(procline(3)))+"); "+procname(4)+"("+alltrim(str(procline(4)))+"); "+procname(5)+"("+alltrim(str(procline(5)))+"); "+vers+"; "+substr(cmessage,1,55)+".")
endif

* ferase( "error.log")

*  MemoWrit( "error.log", "Programa "+hb_cmdargargv()+" deu o erro " + cMessage + " na fun‡Æo "+procname(2)+", linha " + alltrim(str(procline(2))) +", m¢dulo: ..., chamada pela fun‡Æo "+procname(3)+", linha "+alltrim(str(procline(3)))+"; base em uso: "+alias()+"; pasta: "+curdir()+", usu rio: "+us)

   ?"Aguarde"
if us#"I" .and. us#"Evelyn" .and. usebase("\tarefas\numeros")=.t.
   if dtmander<date() .or. (dtmander=date() .and. scmander<seconds()-300)
      mander()
     if usebase("\tarefas\numeros")=.t.
       if rlbs()=.t.
          repl dtmander with date()
          repl scmander with seconds()
       endif
     endif
   endif
   use
else
   mander()
endif

if ( "X/1012" $ cMessage )
   inicio=at("corrompido",cMessage)+12
   arqv=substr(cMessage,inicio,at(".dbf",cMessage)-inicio)+".dbf"
if us="I"
cls
?"Ver erro de ¡ndice corrompido no arquivo "+arqv   
?inicio
?arqv
tone(261.7,333)
endif
   i := 2
   while ( !Empty(ProcName(i)) )
      cMessage += Hb_Eol()     
      cMessage += "Called from" + Trim(ProcName(i)) + "(" + NTRIM(ProcLine(i)) + ")  " + Hb_Eol()
      i++
   end
   use
   __run("del " + arqv)
   if file("pega.bat")
      __run("pega " + ftps + " " + usftp + " " + snhftp + " " + ptftp+"copypen/tarefas . "+arqv)
mandmail1("pega.log","Conferir se pegou arquivo "+arqv)   
   else
      __run("recebe " + ftps + " " + usftp + " " + snhftp + " " + ptftp+"copypen/tarefas . " + arqv )
mandmail1("recebe.log","Conferir se recebeu arquivo "+arqv)   
   endif
   RETURN .T.
ENDIF

**********

   // give up
   ErrorLevel(1)
   QUIT

return (.f.)

/***
*   ErrorMessage()
*/
static func ErrorMessage(e)
local cMessage

   // start error message
   cMessage := if( e:severity > ES_WARNING, "Error ", "Warning " )

   // add subsystem name if available
   if ( ValType(e:subsystem) == "C" )
      cMessage += e:subsystem()
   else
      cMessage += "???"
   end

   // add subsystem's error code if available
   if ( ValType(e:subCode) == "N" )
      cMessage += ("/" + NTRIM(e:subCode))
   else
      cMessage += "/???"
   end

   // add error description if available
   if ( ValType(e:description) == "C" )
      cMessage += ("  " + e:description)
   end

   // add either filename or operation
   if ( !Empty(e:filename) )
      cMessage += (": " + e:filename)

   elseif ( !Empty(e:operation) )
      cMessage += (": " + e:operation)

   end

return (cMessage)

STATIC FUNCTION LogError( oerr )

     LOCAL cScreen
     LOCAL aLogFile    := SET( _SET_ERRORLOG )
     LOCAL cLogFile    := aLogFile[1]  // error log file name
     LOCAL lAppendLog  := aLogFile[2]  // .f. = create a new error log (default) .t. = append to a existing one.
     LOCAL nStart      := 1
     LOCAL nCellSize
     LOCAL nRange
     LOCAL nCols
     LOCAL nRows

     LOCAL nCount

     LOCAL nForLoop
     LOCAL cOutString
     LOCAL cSubString

     LOCAL nHandle
     LOCAL nBytes

     LOCAL nHandle2   := -1
     LOCAL cLogFile2  := "_error.log"
     LOCAL cBuff      := ""
     LOCAL nRead      := 0

     nCols := MaxCol()
     IF nCols > 0
        nRows := MaxRow()
        cScreen := Savescreen()
     ENDIF
     //Alert( 'An error occured, Information will be ;written to error.log' )

     If !lAppendLog
        nHandle := FCreate( cLogFile, FC_NORMAL )
     Else
        If !File( cLogFile )
           nHandle := FCreate( cLogFile, FC_NORMAL )
        Else
           nHandle  := FCreate( cLogFile2, FC_NORMAL )
           nHandle2 := FOpen( cLogFile, FO_READ )
        Endif
     Endif

     If nHandle < 3 .and. lower( cLogFile ) != 'error.log'
        // Force creating error.log in case supplied log file cannot
        // be created for any reason
        cLogFile := 'error.log'
        nHandle := Fcreate( cLogFile, FC_NORMAL )
     Endif

     If nHandle < 3
     Else

        FWriteLine( nHandle, Padc( ' xHarbour Error Log ' , 79, '-' ) )
        FWriteLine( nHandle, '' )

        FWriteLine( nHandle, 'Date...............: ' + dtoc( date() )  )
        FWriteLine( nHandle, 'Time...............: ' + time()          )

        FWriteLine( nHandle, '' )
        FWriteLine( nHandle, 'Application name...: ' + hb_cmdargargv() )
        FWriteLine( nHandle, 'Workstation name...: ' + netname() )
        FWriteLine( nHandle, 'Available memory...: ' + strvalue( Memory(0) )  )
        FWriteLine( nHandle, 'Current disk.......: ' + diskname() )
        FWriteLine( nHandle, 'Current directory..: ' + curdir() )
        FWriteLine( nHandle, 'Free disk space....: ' + strvalue( DiskSpace() ) )
        FWriteLine( nHandle, '' )
        FWriteLine( nHandle, 'Operating system...: ' + os() )
*        FWriteLine( nHandle, 'xHarbour version...: ' + version() )
*        FWriteLine( nHandle, 'xHarbour built on..: ' + hb_builddate() )
*        FWriteLine( nHandle, 'C/C++ compiler.....: ' + hb_compiler() )

*        FWriteLine( nHandle, 'Multi Threading....: ' + If( Hb_MultiThread(),"YES","NO" ) )
*        FWriteLine( nHandle, 'VM Optimization....: ' + strvalue( Hb_VmMode() ) )

*        IF Type( "Select()" ) == "UI"
*        FWriteLine( nHandle, '' )
*        FWriteLine( nHandle, 'Current Area ......:' + strvalue( &("Select()") ) )
*        ENDIF

*        FWriteLine( nHandle, '' )
*        FWriteLine( nHandle, Padc( ' Environmental Information ', 79, '-' ) )
*        FWriteLine( nHandle, '' )

*        FWriteLine( nHandle, "SET ALTERNATE......: " + strvalue( Set( _SET_ALTERNATE  ), .T. ) )
*        FWriteLine( nHandle, "SET ALTFILE........: " + strvalue( Set( _SET_ALTFILE  )      ) )
*        FWriteLine( nHandle, "SET AUTOPEN........: " + strvalue( Set( _SET_AUTOPEN  ), .T. ) )
*        FWriteLine( nHandle, "SET AUTORDER.......: " + strvalue( Set( _SET_AUTORDER )      ) )
*        FWriteLine( nHandle, "SET AUTOSHARE......: " + strvalue( Set( _SET_AUTOSHARE )      ) )

*        FWriteLine( nHandle, "SET BACKGROUNDTASKS: " + strvalue( Set( _SET_BACKGROUNDTASKS ), .T. ) )
*        FWriteLine( nHandle, "SET BACKGROUNDTICK.: " + strvalue( Set( _SET_BACKGROUNDTICK ), .T. ) )
*        FWriteLine( nHandle, "SET BELL...........: " + strvalue( Set( _SET_BELL  ), .T. ) )
*        FWriteLine( nHandle, "SET BLINK..........: " + strvalue( SetBlink()      ) )

*        FWriteLine( nHandle, "SET CANCEL.........: " + strvalue( Set( _SET_CANCEL  ), .T. ) )
*        FWriteLine( nHandle, "SET CENTURY........: " + strvalue( __SetCentury(), .T. ) )
*        FWriteLine( nHandle, "SET COLOR..........: " + strvalue( Set( _SET_COLOR  )      ) )
*        FWriteLine( nHandle, "SET CONFIRM........: " + strvalue( Set( _SET_CONFIRM  ), .T. ) )
*        FWriteLine( nHandle, "SET CONSOLE........: " + strvalue( Set( _SET_CONSOLE  ), .T. ) )
*        FWriteLine( nHandle, "SET COUNT..........: " + strvalue( Set( _SET_COUNT  )      ) )
*        FWriteLine( nHandle, "SET CURSOR.........: " + strvalue( Set( _SET_CURSOR  )      ) )

*        FWriteLine( nHandle, "SET DATE FORMAT....: " + strvalue( Set( _SET_DATEFORMAT )      ) )
*        FWriteLine( nHandle, "SET DBFLOCKSCHEME..: " + strvalue( Set( _SET_DBFLOCKSCHEME )      ) )
*        FWriteLine( nHandle, "SET DEBUG..........: " + strvalue( Set( _SET_DEBUG ), .T. ) )
*        FWriteLine( nHandle, "SET DECIMALS.......: " + strvalue( Set( _SET_DECIMALS )      ) )
*        FWriteLine( nHandle, "SET DEFAULT........: " + strvalue( Set( _SET_DEFAULT )      ) )
*        FWriteLine( nHandle, "SET DEFEXTENSIONS..: " + strvalue( Set( _SET_DEFEXTENSIONS ), .T. ) )
*        FWriteLine( nHandle, "SET DELETED........: " + strvalue( Set( _SET_DELETED ), .T. ) )
*        FWriteLine( nHandle, "SET DELIMCHARS.....: " + strvalue( Set( _SET_DELIMCHARS )      ) )
*        FWriteLine( nHandle, "SET DELIMETERS.....: " + strvalue( Set( _SET_DELIMITERS ), .T. ) )
*        FWriteLine( nHandle, "SET DEVICE.........: " + strvalue( Set( _SET_DEVICE )      ) )
*        FWriteLine( nHandle, "SET DIRCASE........: " + strvalue( Set( _SET_DIRCASE )      ) )
*        FWriteLine( nHandle, "SET DIRSEPARATOR...: " + strvalue( Set( _SET_DIRSEPARATOR )      ) )

*        FWriteLine( nHandle, "SET EOL............: " + strvalue( Asc( Set( _SET_EOL ) ) )  )
*        FWriteLine( nHandle, "SET EPOCH..........: " + strvalue( Set( _SET_EPOCH )      ) )
*        FWriteLine( nHandle, "SET ERRORLOG.......: " + if(!Empty(aLogFile), strvalue( aLogFile[1] )+","+strvalue( aLogFile[2] ), "") )
*        FWriteLine( nHandle, "SET ERRORLOOP......: " + strvalue( Set( _SET_ERRORLOOP )      ) )
*        FWriteLine( nHandle, "SET ESCAPE.........: " + strvalue( Set( _SET_ESCAPE ), .T. ) )
*        FWriteLine( nHandle, "SET EVENTMASK......: " + strvalue( Set( _SET_EVENTMASK )      ) )
*        FWriteLine( nHandle, "SET EXACT..........: " + strvalue( Set( _SET_EXACT ), .T. ) )
*        FWriteLine( nHandle, "SET EXCLUSIVE......: " + strvalue( Set( _SET_EXCLUSIVE ), .T. ) )
*        FWriteLine( nHandle, "SET EXIT...........: " + strvalue( Set( _SET_EXIT ), .T. ) )
*        FWriteLine( nHandle, "SET EXTRA..........: " + strvalue( Set( _SET_EXTRA ), .T. ) )
*        FWriteLine( nHandle, "SET EXTRAFILE......: " + strvalue( Set( _SET_EXTRAFILE )      ) )

*        FWriteLine( nHandle, "SET FILECASE.......: " + strvalue( Set( _SET_FILECASE )      ) )
*        FWriteLine( nHandle, "SET FIXED..........: " + strvalue( Set( _SET_FIXED ), .T. ) )
*        FWriteLine( nHandle, "SET FORCEOPT.......: " + strvalue( Set( _SET_FORCEOPT ), .T. ) )

*        FWriteLine( nHandle, "SET HARDCOMMIT.....: " + strvalue( Set( _SET_HARDCOMMIT ), .T. ) )

*        FWriteLine( nHandle, "SET IDLEREPEAT.....: " + strvalue( Set( _SET_IDLEREPEAT ), .T. ) )
*        FWriteLine( nHandle, "SET INSERT.........: " + strvalue( Set( _SET_INSERT ), .T. ) )
*        FWriteLine( nHandle, "SET INTENSITY......: " + strvalue( Set( _SET_INTENSITY ), .T. ) )

*        FWriteLine( nHandle, "SET LANGUAGE.......: " + strvalue( Set( _SET_LANGUAGE )      ) )

*        FWriteLine( nHandle, "SET MARGIN.........: " + strvalue( Set( _SET_MARGIN )      ) )
*        FWriteLine( nHandle, "SET MBLOCKSIZE.....: " + strvalue( Set( _SET_MBLOCKSIZE )      ) )
*        FWriteLine( nHandle, "SET MCENTER........: " + strvalue( Set( _SET_MCENTER ), .T. ) )
*        FWriteLine( nHandle, "SET MESSAGE........: " + strvalue( Set( _SET_MESSAGE )      ) )
*        FWriteLine( nHandle, "SET MFILEEXT.......: " + strvalue( Set( _SET_MFILEEXT )      ) )

*        FWriteLine( nHandle, "SET OPTIMIZE.......: " + strvalue( Set( _SET_OPTIMIZE ), .T. ) )
*        FWriteLine( nHandle, "SET OUTPUTSAFETY...: " + strvalue( Set( _SET_OUTPUTSAFETY ), .T. ) )

*        FWriteLine( nHandle, "SET PATH...........: " + strvalue( Set( _SET_PATH )      ) )
*        FWriteLine( nHandle, "SET PRINTER........: " + strvalue( Set( _SET_PRINTER ), .T. ) )
*        FWriteLine( nHandle, "SET PRINTERJOB.....: " + strvalue( Set( _SET_PRINTERJOB )      ) )
*        FWriteLine( nHandle, "SET PRINTFILE......: " + strvalue( Set( _SET_PRINTFILE )      ) )

*        FWriteLine( nHandle, "SET SCOREBOARD.....: " + strvalue( Set( _SET_SCOREBOARD ), .T. ) )
*        FWriteLine( nHandle, "SET SCROLLBREAK....: " + strvalue( Set( _SET_SCROLLBREAK ), .T. ) )
*        FWriteLine( nHandle, "SET SOFTSEEK.......: " + strvalue( Set( _SET_SOFTSEEK ), .T. ) )
*        FWriteLine( nHandle, "SET STRICTREAD.....: " + strvalue( Set( _SET_STRICTREAD ), .T. ) )

*        FWriteLine( nHandle, "SET TRACE..........: " + strvalue( Set( _SET_TRACE ), .T. ) )
*        FWriteLine( nHandle, "SET TRACEFILE......: " + strvalue( Set( _SET_TRACEFILE )      ) )
*        FWriteLine( nHandle, "SET TRACESTACK.....: " + strvalue( Set( _SET_TRACESTACK )      ) )
*        FWriteLine( nHandle, "SET TRIMFILENAME...: " + strvalue( Set( _SET_TRIMFILENAME )      ) )

*        FWriteLine( nHandle, "SET TYPEAHEAD......: " + strvalue( Set( _SET_TYPEAHEAD )      ) )

*        FWriteLine( nHandle, "SET UNIQUE.........: " + strvalue( Set( _SET_UNIQUE ), .T. ) )

*        FWriteLine( nHandle, "SET VIDEOMODE......: " + strvalue( Set( _SET_VIDEOMODE )      ) )

*        FWriteLine( nHandle, "SET WRAP...........: " + strvalue( Set( _SET_WRAP ), .T. ) )

        FWriteLine( nHandle, "" )

        IF nCols > 0
            FWriteLine( nHandle, Padc( 'Detailed Work Area Items', nCols, '-' ) )
        ELSE
            FWriteLine( nHandle, 'Detailed Work Area Items ' )
        ENDIF
        FWriteLine( nHandle, "" )

        IF Type( "Select()" ) == "UI"
           For nCount := 1 To 600
              If !Empty( ( nCount )->( &("Alias()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Work Area No ......: " + strvalue( &("Select()") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "Alias .............: " + &("Alias()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Current Recno .....: " + strvalue( &("RecNo()") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "Current Filter ....: " + &("DbFilter()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Relation Exp. .....: " + &("DbRelation()") ) )
                 ( nCount )->( FWriteLine( nHandle, "Index Order .......: " + strvalue( &("IndexOrd(0)") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "Active Key ........: " + strvalue( &("IndexKey(0)") ) ) )
                 ( nCount )->( FWriteLine( nHandle, "" ) )
              Endif
           Next
        ENDIF

        FWriteLine( nHandle, "" )
        IF nCols > 0
            FWriteLine( nHandle, Padc( " Internal Error Handling Information  ", nCols, "-" ) )
        ELSE
            FWriteLine( nHandle, " Internal Error Handling Information  " )
        ENDIF
        FWriteLine( nHandle, "" )
        FWriteLine( nHandle, "Subsystem Call ....: " + oErr:subsystem() )
        FWriteLine( nHandle, "System Code .......: " + strvalue( oErr:suBcode() ) )
        FWriteLine( nHandle, "Default Status ....: " + strvalue( oerr:candefault() ) )
        FWriteLine( nHandle, "Description .......: " + oErr:description() )
        FWriteLine( nHandle, "Operation .........: " + oErr:operation() )
        FWriteLine( nHandle, "Arguments .........: " + Arguments( oErr ) )
        FWriteLine( nHandle, "Involved File .....: " + oErr:filename() )
        FWriteLine( nHandle, "Dos Error Code ....: " + strvalue( oErr:oscode() ) )

        #ifdef HB_THREAD_SUPPORT
        FWriteLine( nHandle, "Running threads ...: " + strvalue( oErr:RunningThreads() ) )
        FWriteLine( nHandle, "VM thread ID ......: " + strvalue( oErr:VmThreadId() ) )
        FWriteLine( nHandle, "OS thread ID ......: " + strvalue( oErr:OsThreadId() ) )
        #endif

        FWriteLine( nHandle, "" )
        FWriteLine( nHandle, " Trace Through:" )
        FWriteLine( nHandle, "----------------" )

fWriteLine ( nHandle, "Base em uso: "+alias() )
fWriteLine ( nHandle, "Pasta: "+curdir() )
*if type("us")#"U"
   fWriteLine ( nHandle, "US:"+us )
*endif
fWriteLine ( nHandle, "Versão: "+vers )
        FWriteLine( nHandle, Padr( oErr:ProcName, 21 ) + " : " + Transform( oErr:ProcLine, "999,999" ) + " in Module: " + oErr:ModuleName )
        nCount := 3
        While !Empty( Procname( ++ nCount ) )
          FWriteLine( nHandle, Padr( Procname( nCount ), 21 ) + ' : ' + Transform( Procline( nCount ), "999,999" ) + " in Module: " + ProcFile( nCount ) )
        Enddo

        FWriteLine( nHandle, "" )
        FWriteLine( nHandle, "" )

        IF valtype( cScreen ) == "C"
            FWriteLine( nHandle, Padc( " Video Screen Dump ", nCols, "#" ) )
            FWriteLine( nHandle, "" )
            //FWriteLine( nHandle, "" )
            FWriteLine( nHandle, "+" + Replicate( '-', nCols + 1 ) + "+" )
            //FWriteLine( nHandle, "" )
            nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
            nRange := ( nCols + 1 ) * nCellSize
            For nCount := 1 To nRows + 1
               cOutString := ''
               cSubString := Substr( cScreen, nStart, nRange )
               For nForLoop := 1 To nRange step nCellSize
                  cOutString += Substr( cSubString, nForLoop, 1 )
               Next
               FWriteLine( nHandle, "|" + cOutString + "|" )
               nStart += nRange
            Next
            FWriteLine( nHandle, "+" + Replicate( '-', nCols + 1 ) + "+" )
            FWriteLine( nHandle, "" )
            FWriteLine( nHandle, "" )
        ELSE
            FWriteLine( nHandle, " Video Screen Dump not available" )
        ENDIF

    /*
     *  FWriteLine( nHandle, padc(" Available Memory Variables ",nCols,'+') )
     *  FWriteLine( nHandle, "" )
     *  Save All Like * To errormem
     *  nMemHandle := Fopen( 'errormem.mem', FO_READWRITE )
     *  nMemLength := Fseek( nMemHandle, 0, 2 )
     *  Fseek( nMemHandle, 0 )
     *  nCount := 1
     *  While Fseek( nMemHandle, 0, 1 ) + 1 < nMemLength
     *    nMemWidth := Space( 18 )
     *    Fread( nMemHandle, @nMemWidth, 18 )
     *    cVarName  := Left( nMemWidth, At( Chr( 0 ), nMemWidth ) - 1 )
     *    cVarType  := Substr( nMemWidth, 12, 1 )
     *    cVarRec   := Bin2w( Right( nMemWidth, 2 ) )
     *    nMemCount := If( cVarType IN Chr( 195 ) + Chr( 204 ), 14 + cVarRec, 22 )
     *    Fseek( nMemHandle, nMemCount, 1 )
     *    cTemp  := Left( cVarName + Space( 10 ), 10 )
     *    cTemp  += " TYPE " + Type( cVarName )
     *    cTemp  += " " + If( Type( cVarName ) == "C", '"' + &cVarName + '"', strvalue( &cVarName ) )
     *    nBytes := 0
     *    Switch ValType( cVarName )
     *        Case "C"
     *            nBytes += ( nLenTemp := Len( &cVarName ) )
     *            exit
     *        Case "N"
     *            nBytes += ( nLenTemp := 9 )
     *            exit
     *        Case 'L'
     *            nBytes += ( nLenTemp := 2 )
     *            exit
     *        Case "D"
     *            nBytes += ( nLenTemp := 9 )
     *            exit
     *    End
     *    Fwrite( nFhandle, "            " + Transform( nLenTemp, '999999' ) + 'bytes -> ' )
     *    FWriteLine( nHandle, "      " + cTemp )
     *  Enddo
     *  Fclose( nMemHandle )
     *  Ferase( 'errormem.mem' )
     */
        if lAppendLog .and. nHandle2 != -1

           nBytes := FSeek( nHandle2, 0, FS_END )

           cBuff := space(10)
           FSeek( nHandle2, 0, FS_SET )

           while nBytes > 0
             nRead := FRead( nHandle2, @cBuff, 10 )
             FWrite( nHandle, cBuff, nRead )
             nBytes -= nRead
             cBuff := space( 10 )
           enddo

           FClose( nHandle2 )
           FClose( nHandle )

           FErase( cLogFile )
           FRename( cLogFile2, cLogFile )
        else
           FClose( nHandle )
        endif

     Endif

Return .f.

STATIC FUNCTION FWriteLine( nh, c )

   Fwrite( nh, c + HB_OsNewLine() )
   //HB_OutDebug( c + HB_OsNewLine() )
Return nil

STATIC FUNCTION Arguments( oErr )

   LOCAL xArg, cArguments := ""

   IF ValType( oErr:Args ) == "A"
      FOR EACH xArg IN oErr:Args
         cArguments += " [" + Str( HB_EnumIndex(), 2 ) + "] = Type: " + ValType( xArg )

         IF xArg != NIL
            cArguments +=  " Val: " + CStr( xArg )
         ENDIF
      NEXT
   ENDIF

RETURN cArguments

STATIC FUNCTION strvalue( c, l )

     LOCAL cr := ''
*     Default l To .f.
     Switch ValType( c )
         Case "C"
             cr := c
             exit
         Case "N"
             cr := Alltrim( Str( c ) )
             exit
         Case "M"
             cr := c
             exit
         Case "D"
             cr := Dtoc( c )
             exit
         Case "L"
//             cr := If( l, If( c, "On", "Off" ), If( c, "True", "False" ) )
             cr := If( l, If( c, "On", "Off" ), If( c, ".t.", ".f." ) )
             exit
     End
Return Upper( cr )

FUNCTION throwerr (enum, esev, eargs)
LOCAL e := errornew()
e:gencode := 0
e:subcode := enum
e:subsystem := "MYCODE"
e:cargo := eargs
e:severity := IIF (esev == NIL, ES_WHOCARES, esev)
RETURN eval
(errorblock(), e)


Mas note que o problema não é não conectar, e sim erro na linha em que chama a conexão. Eu até testei colocar um else no IF nConnection == 0, mas ele nem chega aí. Ou seja, não é que não esteja conectando, o problema é que está dando erro na linha de conexão.

O us é sim = "I". Mas, por via das dúvidas, tirei essa verificação, e o erro continua.

Os dados da conexão que estou usando estão corretos, pois estou usando a linha de conexão exatamente igual ao demo.prg, que vc fez, e no demo.prg aqui compilado, está rodando normalmente.

Se vc quiser testar diretamente, pode usar minha senha que foi indevidamente postada anteriormente (caso vc ainda não tenha, posso te passar novamente.
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 26 Mai 2014 14:43

cjp escreveu:Mas vc está certo de que realmente ele indica o erro em outra parte do programa.

Se consegui entender este seu log de erro, o primeiro lugar onde o errorsys é chamado é na linha 26523 do arquivo COMUNS.PRG:
Vindo de......: SQLAGTC(26523 - COMUNS.PRG)

Depois desta linha no log observe que o seu errorsys entra em um loop, um erro recursivo.
Notei que neste seu errorsys você abre alguns arquivos DBF, então você teria que colocar o comando RDDSETDEFAULT("DBF") uma linha após o início da função ErrorSys().

cjp escreveu:Se vc quiser testar diretamente, pode usar minha senha que foi indevidamente postada anteriormente (caso vc ainda não tenha, posso te passar novamente.

Eu fiz aqui um teste, abrindo um browse com um arquivo DBF antes de chamar a função sqlagtc(), e depois de sair da função, abri novamente o arquivo DBF. Bom, funcionou certinho.

Você deve ter ai algum arquivo de compilação (HBP,BAT,HBC, etc) que deve estar faltando alguma coisa ou usando algo que está entrando em conflito.

Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 26 Mai 2014 17:17

Sim, nessa linha 26523 mesmo, que está com o nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server...

Realmente ele está em loop por causa do RDD.

Estou compilando com este .BAT:

cd\hb32\bin
del *.prg
del *.tds
del *.c
del *.ppo
del *.obj
del *.map
del agenda.exe*
copy \prg\agenda.prg
copy \prg\banco.prg
copy \prg\contag.prg
copy \prg\agtel.prg
copy \prg\agcom.prg
copy \prg\contap.prg
copy \prg\alerta.prg
copy \prg\bccadm.prg
copy \prg\contex.prg
copy \prg\contabc.prg
copy \prg\contsem.prg
copy \prg\semcont.prg
copy \prg\contec.prg
copy \prg\contval.prg
copy \prg\relat.prg
copy \prg\poupa.prg
copy \prg\contcart.prg
copy \prg\contcrt2.prg
copy \prg\list2.prg
copy \prg\aniv.prg
copy \prg\xxx.prg
copy \prg\contbtn.prg
copy \prg\abrfech.prg
copy \prg\relat.prg
copy \prg\cartoes.prg
copy \prg\calcula.prg
copy \prg\contpoup.prg
copy \prg\extenso.prg
copy \prg\comuns.prg
copy \prg\errors2.prg
copy \prg\getsys.prg
copy \agenda\ag.hbp

hbmk2 ag.hbp -lxhb -lhbct -lhbmisc

copy agenda.exe \agenda


E o ag.HBP está assim:

# coloque aqui suas libs, precedidas pela letra "l" (minúscula):
-lxhb
-lhbwin
-lhbtip
-lhbct
-lhbHPdf
-lhbZebra
-lhbmisc

# coloque aqui os parâmetros de compilação:
-quiet
-jobs=4
-oAGENDA

# coloque aqui seus arquivos PRGs:
AGENDA.PRG
COMUNS.PRG
CONTABC.PRG
banco.prg
contag.prg
agtel.prg
agcom.prg
contap.prg
alerta.prg
bccadm.prg
contex.prg
contsem.prg
semcont.prg
contec.prg
contval.prg
relat.prg
poupa.prg
contcart.prg
contcrt2.prg
list2.prg
aniv.prg
xxx.prg
contbtn.prg
abrfech.prg
cartoes.prg
calcula.prg
contpoup.prg
extenso.prg
getsys.prg
errors2.prg
rddsql.hbc
sddodbc.hbc


Tem algo errado?
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 26 Mai 2014 18:07

cjp escreveu:hbmk2 ag.hbp -lxhb -lhbct -lhbmisc

Se você está usando um arquivo HBP para compilar, então não é necessário informar -lxhb -lhbct -lhbmisc, pois eles já estão no arquivo HBP.

cjp escreveu:rddsql.hbc
sddodbc.hbc

Mova estes comandos junto com as libs, logo depois de -lhbmisc

Notei que você copia os arquivos PRG e o HBP para a pasta c:\hb32\bin e depois faz o compilação, é estranho este procedimento, mas deve funcionar. O correto (geralmente) seria setar no PATH a pasta do Harbour e fazer a compilação na pasta onde está os arquivos PRGs (veja este tópico).

Outro detalhe nesta maneira de você compilar, os arquivos rddsql.hbc e sddodbc.hbc estão junto com os arquivos PRG (na pasta c:\hb32\bin)?

Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 26 Mai 2014 23:04

Realmente o -lxhb -lhbct -lhbmisc era desnecessário.

Mas, ao mover o rddsql.hbc e o sddodbc.hbc para o lugar das libs no hbp, está dando o seguinte erro na compilação:

not yet supported command line option: rddsql.hbc


E também:

Error F0034 Bad command line option 'sddodbc.hbc'


Não sei se fiz alguma coisa errada. Meu .HBP ficou assim:

# coloque aqui suas libs, precedidas pela letra "l" (minúscula):
-lxhb
-lhbwin
-lhbtip
-lhbct
-lhbHPdf
-lhbZebra
-lhbmisc
-rddsql.hbc
-sddodbc.hbc

# coloque aqui os parâmetros de compilação:
-quiet
-jobs=4
-oAGENDA

# coloque aqui seus arquivos PRGs:
AGENDA.PRG
COMUNS.PRG
CONTABC.PRG
banco.prg
contag.prg
agtel.prg
agcom.prg
contap.prg
alerta.prg
bccadm.prg
contex.prg
contsem.prg
semcont.prg
contec.prg
contval.prg
relat.prg
poupa.prg
contcart.prg
contcrt2.prg
list2.prg
aniv.prg
xxx.prg
contbtn.prg
abrfech.prg
cartoes.prg
calcula.prg
contpoup.prg
extenso.prg
getsys.prg
errors2.prg


Eu prefiro compilar na pasta do Harbour porque tenho vários PRGs salvo na pasta PRG, sendo que nem todos entram em todos os programas. Mas é mais uma questão de costume mesmo.

Sim, os arquivos sddsql.hbc e sddodbc.hbc está na pasta c:\hb32\bin.
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 27 Mai 2014 07:30

cjp escreveu:Não sei se fiz alguma coisa errada.

Na minha mensagem anterior instrui apenas para mover o rddsql.hbc e o sddodbc.hbc, então favor tirar o sinal de menos que você colocou antes dos arquivos.

Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 27 Mai 2014 11:42

Achei que era pra ficar no mesmo padrão dos demais.

Tirei o -. Compilou, mas continua dando o mesmo erro na linha nConnection.

Estou fazendo um outro teste, para tentar simplificar o problema. Separei deste programa apenas algumas funções essenciais para testar. Fiz um outro programa à parte, com apenas um prg, com esta função sqlagtc() e com uso também de DBF. Ficou assim:

#include "inkey.ch"
#include "hbgtinfo.ch"
         #include "dbinfo.ch"
         #define RDDI_CONNECT     1001
         #define RDDI_DISCONNECT   1002
         #define RDDI_EXECUTE     1003
         REQUEST SQLMIX, SDDODBC, _DBF
         ANNOUNCE RDDSYS

REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850

function main()
         RDDSETDEFAULT("DBF")
         HB_SETCODEPAGE('PT850')
         HB_LANGSELECT('PT')
         public usooff :="N"

       cls
      
         us="I"
         dt=date()
         hr=time()

!netsh firewall set opmode mode = disable >nul

SET COLOR TO W/B,b/w
setmode(42,100)
vers="21/11/12"

usebase("snh")
sh=ativa
sn=val(senha)

pargerais()

if !file("c:\lixo\agemuso.cpd")
   copy file "c:\tarefas\erro.dbf" to "c:\lixo\agemuso.cpd"
endif   
copy file "c:\lixo\agemuso.cpd" to "c:\tarefas\agemuso.cpd"

if !file("\lixo\copypen.dbf") .and. !file("\lixo\agenda.dbf") .and. !file("\lixo\comida.dbf")
   dirmake("\lixo")
endif


if sh="S"
   clear
   snh:=getsecret("   ",5,5,.T.,"Digite a senha:")
   snh=val(snh)
   usebase("registro")
   if snh#sn .and. snh#111 .and. !file("c:\windows\jeanice.cpd")
      go bottom
      append blank
      replace data with date()
      replace hora with time()
      replace senha with str(snh)
      if snh#sn .and. snh#111 .and. snh#185
         tone(261.7,3)
         @ 23,5 say "Você não está autorizado a usar o programa"
         inkey(3)
         set color to
         clear
         return
      endif
   else
      us="I"
      if !file("c:\lixo\copypen.dbf")
         tone(261.7,3)
         tone(261.7,3)
         tone(261.7,3)
         clear
         @ 5,5 say "Atenção: agenda não está neste computador"
         tone(261.7,3)
         inkey(3)
         inkey(30)
      endif
      if reccount()>0
         tone (261.7,3)
         @ 5,5 say "Há registros na base Registro"
         inkey(3)
      endif
   endif
else
   snh=0
endif

    
set key 274 to edbase //ALT-e - util.prg
ativ="ativi"


save scre to tl0                                                                                                                                                                                                                                                                                                                                             
do while .t.                                                                                                                                                                                                                                                                                                                                                 
DO WHILE .T.
   set cursor on
   use
   rest scre from tl0
   OPC=0
   CLEAR                                                                                                                                                                                                                                                                                                                                                     
   @ maxrow()-2,1 say "Calculadora:[F10];backup:[F8];calendário:[F9];criar base:[F2];alt.hora:ALT-R;pedágio:ALT-G;edita:ALT-E"
   @ maxrow()-1,1 say "recados:CTRL-R;an.lig.:[F7];cad.tarefas:ALT-M;impr.tela:CTRL-P;crianças:ALT-V;horários:ALT-H"
DispBox( 0, 0, 2, MaxCol(), Nil, "GR+/N" )
DispBox( 3, 0, MaxRow(), MaxCol(), Nil, "G+/N" )
   @ 1,1 PROMPT "Finalizar"                                                                                                                                                                                                                                                                                                                                   
   @ 1,15 PROMPT "Ag.financeira"                                                                                                                                                                                                                                                                                                                             
   @ 1,maxcol()/3+4 prompt "Contas bancárias"                                                                                                                                                                                                                                                                                                                           
   @ 1,maxcol()-maxcol()/3-1 PROMPT "Telefones"                                                                                                                                                                                                                                                                                                                                 
   @ 1,maxcol()-13 PROMPT "Compromissos"                                                                                                                                                                                                                                                                                                                               
   MENU TO OPC                                                                                                                                                                                                                                                                                                                                               
   save screen to tl0                                                                                                                                                                                                                                                                                                                                         
   DO CASE                                                                                                                                                                                                                                                                                                                                                   
         
      case OPC=1 .or. opc=0                                                                                                                                                                                                                                                                                                                                   
           exit                                                                                                                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                                                                                                                             
      CASE OPC=2
                                                                                                                                                                                                                                                                                                                                                             
      CASE OPC=3
                                                                                                                                                                                                                                                                                                                                                             
      CASE OPC=4                                                                                                                                                                                                                                                                                                                                             
           sqlagtc()                                                                                                                                                                                                                                                                                                                                           
                                                                                                                                                                                                                                                                                                                                                             
      CASE OPC=5

   ENDCASE
enddo                                                                                                                                                                                                                                                                                                                                                         
@ 8,13 to 12,37 double                                                                                                                                                                                                                                                                                                                                         
@ 8,49 to 12,60 double                                                                                                                                                                                                                                                                                                                                     
@ 10,15 prompt "Retornar ao programa"                                                                                                                                                                                                                                                                                                                         
@ 10,52 prompt "Sair"
menu to sb                                                                                                                                                                                                                                                                                                                                                   
enddo       
dirchange("\agenda")
if snh#654
   use registro
   go bottom
   replace saida with time()
endif
SET COLOR TO
CLEAR                                                                                                                                                                                                                                                                                                                                                         
USE
erase c:\tarefas\agemuso.cpd
if file("c:\tarefas\agemuso.cpd")
   tone(261.7,3)
   clear
   ?"Erro: agenda 609"
   tone(261.7,33)
   tone(261.7,55)
   wait ""
   wait ""
endif
erase crtemp.dbf
erase agcomhj.dbf
erase bb2.dbf
erase bb3.dbf
erase bb4.dbf
erase inddt.dbf
erase indcart.dbf
erase indliv.dbf
erase nomecart.dbf
!del *.ntx
!del \diversos\*.ntx
!del c:\tarefas\atemp*.dbf >nul
!del smtp*.log
!del pop*.log
!del \tarefas\smtp*.log
!del \tarefas\pop*.log
!del \tarefas\cons?1*.dbf
!del \tarefas\cons?2*.dbf
!del \tarefas\cons?3*.dbf
!del \tarefas\cons?4*.dbf
!del \tarefas\cons?5*.dbf
!del \tarefas\cons?6*.dbf
!del \tarefas\cons?7*.dbf
!del \tarefas\cons?8*.dbf
!del \tarefas\cons?9*.dbf
!del \tarefas\ftp*.log
!c:                                                                                                                                                                                                                                         
RETURN

function sqlagtc
    LOCAL nConnection
    _rddantes:=RDDSETDEFAULT( "SQLMIX" )
    nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.xxx.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=xxx;pwd=xxx;database=xxx;" } )
    IF nConnection == 0
       Alert("Erro na conexao com o servidor")
      RDDSETDEFAULT( _rddantes )
      Return .f.
else
?"Conectou"
tone(261.7,3)
wait ""    
    ENDIF
    DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
    INDEX ON FIELD->NOME TAG nome TO agtel
    GO TOP
    Browse()
    DBCLOSEALL()
    RDDSETDEFAULT( _rddantes )
Return .t.

function usebase(nomebase,exclusivo)
       bssembarra=nomebase
         if empty(nomebase)
            mandmail1("","Usebase sem nome da base (comuns 15250): "+bssembarra)
            return .f.
         endif
         if at(".DBF",upper(nomebase))#0
            nomebase=substr(nomebase,1,at(".DBF",upper(nomebase))-1)
         endif
         vezusb=0
         do while .t.
            if file(nomebase+".dbf")
               if filesize(nomebase+".dbf")=0 .or. filesize(nomebase+".dbf")=-1
                  if us="I"
                  ?
                     ?"Arquivo "+nomebase+ " com problema; aguarde tentativa de resolver o problema"
                  endif
                  if "\"$nomebase
                     if us="I"
                        ?
                        ?"Não é possível resolver o problema para arquivo de outra pasta"
                     endif
                     inkey(.2)
                     return .f.
                  endif
                  if us#"I"
                if "CONSULTA"$upper(nomebase)
                   erase consulta.dbf
                  ?
                  ?"O arquivo CONSULTA.DBF estava com problema e foi excluído; faça uma atualização de índices"
                  ?"para refazer o arquivo de forma correta"
                  inkey(10)
                  return .f.
                endif
                  endif
                  if filesize(nomebase)=0 .or. filesize(nomebase)=-1
                     if filesize(nomebase)=0 .or. filesize(nomebase)=-1
                        if us#"I"
                     if nomebase=seis
                        __run("del "+nomebase)
                              nvestr := {}
                              aadd(nvestr,{"comandos","C", 25, 0})
                              dbcreate(seis,nvestr)
                     endif
                           if filesize(nomebase)=0 .or. filesize(nomebase)=-1
                        if at("CONSULTA",upper(nomebase))=0 .and. file("consulta.dbf")
                           use ("consulta")
                          if !neterr()
                             locate for alltrim(nomebase)+".dbf"$arquivo
                            if found()
                               dele
                              pack
                            endif
                          endif
                        endif
                     endif
                        else
                           ?"Problema não resolvido"
                           inkey(10)
                        endif
                     endif
                     inkey(5)
                     return .f.
                  endif
               endif
               if valtype(exclusivo)="U"
               exclusivo="N"
               endif   
            bssembarra=nomebase
            do while .t.
               if "\"$bssembarra .and. at("\\",bssembarra)=0
*if us="U"
*mandmail1("","Ver como está CONSTEXT no do while: "+bssembarra)
*endif            
                  bssembarra=substr(bssembarra,at("\",bssembarra)+1)
              else
                 exit
              endif
            enddo

if empty(bssembarra)
   mandmail1("","Bssembarra vazio")
   return .f.
endif
if empty(nomebase)
   mandmail1("","Nomebase vazio")
   return .f.
endif
               if upper(exclusivo)#"S" .and. ("ATIV"$upper(nomebase) .or. "NUMEROS"$upper(nomebase) .or. "RODRIGO"$upper(nomebase) .or. "BEATRIZ"$upper(nomebase) .or. "ATCAM"$upper(nomebase) .or. "ATROD"$upper(nomebase) .or. "ATBIA"$upper(nomebase) .or. "PROC"$upper(nomebase) .or. at("COM",upper(nomebase))=1 .or. at("CONSULTA",upper(nomebase))=1 .or. "ARQBX"$upper(nomebase) .or. "RELATOR"$upper(nomebase) .or. "REUS"$upper(nomebase) .or. "TIPOSP"$upper(nomebase) .or. "USUAR"$upper(nomebase) .or. "1"$upper(nomebase) .or. "2"$upper(nomebase) .or. "3"$upper(nomebase)) // .or. upper(curdir())="TAREFAS")
              vezusb=0
                  if select(bssembarra) = 0
                     use &nomebase. shared //new
                  else
                     DbSelectArea(bssembarra)
                 exit
                  endif
            else
               if select(bssembarra) = 0
                 use &nomebase. //new
               else
                     DbSelectArea(bssembarra)
                 if exclusivo="S"
                   use
                   use &nomebase. //new
                 else
                   exit
                endif   
               endif
            endif    
               if neterr()
                  vezusb++
                  if ("TAR2P"$upper(hb_progname()) .and. vezusb>120) .or. (at("TAR2P",upper(hb_progname()))=0 .and. vezusb>60)
                     return .f.
                  endif
              if vezusb=120 .or. vezusb=220 //.or. vezusb=280 .or. vezusb=200 .or. vezusb=240
                 nHand=999
                 if at("TAR2P",upper(hb_progname()))=0
                    nHand := FOpen( "\tarefas\TAR2P.EXE " , 2 )
                  fclose(nHand)
                 endif      
                 mandmail1("","Base em uso por "+alltrim(str(vezusb))+" vezes:"+nomebase+"; exclusivo: "+exclusivo+"; área atual: "+alltrim(str(select()))+"; área da base "+nomebase+": "+alltrim(str(select(nomebase)))+"; aliás1: "+alias(1)+"; aliás2: "+alias(2)+"; aliás3: "+alias(3)+"; aliás4: "+alias(4)+"; nhand: "+alltrim(str(nHand))+"; select(nomebase): "+alltrim(str(select(nomebase)))+"; tamanho da base: "+alltrim(str(filesize(nomebase))))
              endif
                  @ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
                  @ maxrow()-1,1 say "Base "+upper(nomebase)+" ocupada; aguarde liberação ("+alltrim(str(vezusb))+")"
              if us="I"
                 @ maxrow(),1 say "Área: "+alltrim(str(select()))+"; aliás1: "+alias(1)+"; aliás2: "+alias(2)+"; aliás3: "+alias(3)+"; aliás4: "+alias(4)+"; select(nomebase): "+alltrim(str(select(nomebase)))
              endif
              inkey(8)
              @ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
                  desiste:=inkey(8)
                  if desiste= 27 //K_ESC
                     conf="N"
                     @ maxrow()-2,1 clear to maxrow(),79
                     @ maxrow()-1,5 say "Confirma abandono da tentativa da utilização?"get conf pict "@!"
                     read
                     @ maxrow()-2,1 clear to maxrow(),79
                     if conf="S"
                        return .f.
                     endif
                  endif
               else
                  exit
               endif
            else
               if us="I" .and. at("ATEMP",upper(nomebase))=0
                  @ 1,1 clear to 23,79
                  @ 11,5 say "Base "+nomebase+" inexistente"
              @ 12,5 say "Bssembarra: "+bssembarra
                  @ 13,5 say "Pasta corrente: "+curdir()
                  @ 14,5 say "Função chamadora: "+procname(1)
                  @ 15,5 say "Linha: "+alltrim(str(procline(1)))
              tone(261.7,33)
                  inkey(15.5)
               endif
               return .f.
            endif
         enddo
return .t.

function mandmail1(arqmand,assmail,arqanx,inc)
         nsec=0
       @ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
       @ maxrow()-1,1 say "Aguarde..."
       if inc=2
          dstmail="ibcneto"
       else
          dstmail="inacio"
       endif
       nrarea=select()
       sele 4
       if usebase("\tarefas\numeros")=.t. .and. procname(1)#"VERPROCV"
          if (assmail==assultm .and. substr(time(),1,2)==hrultm) .or. (assmail=asspenm .and. substr(time(),1,2)==hrpenm)
             if usebase("\tarefas\"+ativ)=.t.
               a=1
               b=1
               do while .t.
                  append blank
                  if rlbs()
                     repl data with date()
                     repl hora with time()
                     repl acao with "Mandm1-igual"
                     repl nrtarefa with substr(hb_progname(),a,6)
                     repl assunto with substr(assmail,b,16)
                 endif
                 a=a+6
                 b=b+216
                 if empty(substr(hb_progname(),a,6)) .and. empty(substr(assmail,b,16))
                    exit
                 endif
               enddo
            endif
            use
            sele (nrarea)
             return
          else
             asspenm=assultm
             assultm=assmail
            hrpenm=hrultm
            hrultm=substr(time(),1,2)
              if rlbs()=.t.
               repl asspenmail with assultmail
               repl hrpenmail with hrultmail
               repl assultmail with assultm
               repl hrultmail with hrultm
            endif
          endif
       endif
       use
       sele (nrarea)
       if upper(procname(1))="VERMAIL"
          cMessage=arqmand
       else
             nCols := MaxCol()
            nRows := MaxRow()
            nStart      := 1
            cScreen := Savescreen()
           cMessage = "Vídeo Screen Dump:" + Hb_Eol()
            cMessage += Replicate( '-', nCols +3 ) + Hb_Eol()
            nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
            nRange := ( nCols + 1 ) * nCellSize
            For nCount := 1 To nRows + 1
                cOutString := ''
                cSubString := Substr( cScreen, nStart, nRange )
                For nForLoop := 1 To nRange step nCellSize
                    cOutString += Substr( cSubString, nForLoop, 1 )
                Next
              cMessage += "|" + cOutString + "|" + Hb_Eol()
                nStart += nRange
            Next
            cMessage += Replicate( '-', nCols +3 ) + Hb_Eol()
       endif   
       assmail=ansi(alltrim(nmus)+": "+assmail) //+"; versão:"+vers+"; proc1: "+procname(1)+" ("+alltrim(str(procline(1)))+"); proc2: "+procname(2)+" ("+alltrim(str(procline(2)))+"); proc3: " +procname(3)+" ("+alltrim(str(procline(3)))+"); máquina: "+netname())

         if arqmand="error.log" .and. file("error.log")
            contmail=""
         else         
          contmail=hb_eol()+"Programa...: "+hb_progname();
                 +hb_eol()+"Versão.....: "+vers+hb_eol();
                 +hb_eol()+"Máquina....: "+netname();
               +hb_eol()+"Pasta atual: "+curdir()+hb_eol();
                 +hb_eol()+"Proc1......: "+procname(1)+" ("+alltrim(str(procline(1)))+")"+hb_eol();
                    +if(!empty(procname(2)),"Proc2......: "+procname(2)+" ("+alltrim(str(procline(2)))+")"+hb_eol(),"");
                 +if(!empty(procname(3)),"Proc3......: "+procname(3)+" ("+alltrim(str(procline(3)))+")"+hb_eol(),"");
                 +if(!empty(procname(4)),"Proc4......: "+procname(4)+" ("+alltrim(str(procline(4)))+")"+hb_eol(),"");
                 +if(!empty(procname(5)),"Proc5......: "+procname(5)+" ("+alltrim(str(procline(5)))+")"+hb_eol(),"");
                 +if(!empty(procname(6)),"Proc6......: "+procname(6)+" ("+alltrim(str(procline(6)))+")"+hb_eol(),"");
                 +if(!empty(procname(7)),"Proc7......: "+procname(7)+" ("+alltrim(str(procline(7)))+")"+hb_eol(),"");
                 +if(!empty(procname(8)),"Proc8......: "+procname(8)+" ("+alltrim(str(procline(8)))+")"+hb_eol(),"");
                 +if(!empty(procname(9)),"Proc9......: "+procname(9)+" ("+alltrim(str(procline(9)))+")"+hb_eol(),"");
                 +if(!empty(procname(10)),"Proc10.....: "+procname(10)+" ("+alltrim(str(procline(10)))+")"+hb_eol(),"");
                 +if(!empty(procname(11)),"Proc11.....: "+procname(11)+" ("+alltrim(str(procline(11)))+")"+hb_eol(),"");
                 +if(!empty(procname(12)),"Proc12.....: "+procname(12)+" ("+alltrim(str(procline(12)))+")"+hb_eol(),"");
                 +if(!empty(procname(13)),"Proc13.....: "+procname(13)+" ("+alltrim(str(procline(13)))+")"+hb_eol(),"");
                 +if(!empty(procname(14)),"Proc14.....: "+procname(14)+" ("+alltrim(str(procline(14)))+")"+hb_eol(),"");
                 +if(!empty(procname(15)),"Proc15.....: "+procname(15)+" ("+alltrim(str(procline(15)))+")"+hb_eol(),"");
                 +hb_eol()+"Área em uso: "+alltrim(str(select()))+hb_eol();
                 +"Área 1.....: " + alias(1) + Hb_Eol();
                    +if(!empty(alias(2)),"Área 2.....: "+alias(2)+Hb_Eol(),"");
                 +if(!empty(alias(3)),"Área 3.....: "+alias(3)+Hb_Eol(),"");
                 +if(!empty(alias(4)),"Área 4.....: "+alias(4)+Hb_Eol(),"");
                 +if(!empty(alias(5)),"Área 5.....: "+alias(5)+Hb_Eol(),"");
                 +if(!empty(alias(6)),"Área 6.....: "+alias(6)+Hb_Eol(),"");
                 +if(!empty(alias(7)),"Área 7.....: "+alias(7)+Hb_Eol(),"");
                 +if(!empty(alias(8)),"Área 8.....: "+alias(8)+Hb_Eol(),"");
                 +if(!empty(alias(9)),"Área 9.....: "+alias(9)+Hb_Eol(),"");
                 +"Nrarea.....: "+alltrim(str(nrarea));
                 +hb_eol()+"Data.......: "+dtoc(date());
               +hb_eol()+"Hora.......: "+time();
                 +hb_eol()+hb_eol()+cMessage+hb_eol()
       endif
      
        if hb_sendmail("smtp.xxx.com.br",587,"programa@inaciocarvalho.com.br",{dstmail+"@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"programa@inaciocarvalho.com.br","xxx","pop3.xxx.com.br",,,.T.,.t.,,,)=.f.
          if verint()=.f.
             if at("VERMAIL",procname(1))=0 .and. at("VERMAIL",upper(procname(2)))=0 .and. at("VERMAIL",upper(procname(3)))=0
               if type("arqanx")="U"
                 arqanx=""
              endif
            endif    
            return .f.
         endif
         if hb_sendmail("smtp.expressomx03.pr.gov.br",465,alltrim(nmus)+"@mp.pr.gov.br",{dstmail+"@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"ibcneto","xxx","imap.expressomx03.pr.gov.br",,,.T.,.t.,,,)=.f.
            if hb_sendmail("smtp.onda.com.br",587,"inaciocarvalho@onda.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"inaciocarvalho","xxx","pop3.onda.com.br",,,.T.,.t.,,,)=.f.
               if hb_sendmail("smtp.inaciocarvalho.com.br",587,"inacio@inaciocarvalho.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"inacio@inaciocarvalho.com.br","xxx","pop3.inaciocarvalho.com.br",,,.T.,.t.,,,)=.f.
                  if hb_sendmail("smtp.inaciocarvalho.com.br",587,"inaciocarvalho@inaciocarvalho.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"inaciocarvalho@inaciocarvalho.com.br","xxx","pop3.inaciocarvalho.com.br",,,.T.,.t.,,,)=.f.
                     if hb_sendmail("smtp.inaciocarvalho.com.br",587,"programa@inaciocarvalho.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"programa@inaciocarvalho.com.br","xxx","pop3.inaciocarvalho.com.br",,,.T.,.t.,,,)=.f.
                           __run("smtpsend -@mailv.txt -s" + assmail + " >result.txt")
                      if file("result.txt")
                             if type("arqanx")="U"
                             arqanx=""
                          endif
                     endif
                    endif      
                        return .f.
                endif   
              endif   
               endif
            endif
         endif
       @ maxrow()-1,1 clear to maxrow()-1,15
return .t.

function pargerais
if "AG"$upper(hb_progname()) .or. "COPYP"$upper(hb_progname())
   public nmus :="Inacio"
   public ptreceb :="inacio"
   public ativ :="ativi"
   public us :="I"
else
   public ptreceb :=""
endif
if us="I" .or. us="H"
   public seis :=""
endif   
if valtype("usooff")#"U"
   public usooff :="N"
endif
public fAtiva :=.t.
public vzidle :=0
public erecftp :="" //recebftp
public vzerr :=0
public tarfaz :="nada"
public vzresp2 :=0
public hrintar :=0
public vztpexc :=0
public assultm :=""
public hrultm :=""
public asspenm :=""
public hrpenm :=""
public snhftp :="Dani2013"
public ftps :="ftp.inaciocarvalho.com.br"
public ptftp :="/inaciobr/"
public usftp :="inaciobr"
public tarord :="S"
public nrvzatind :=0
public pratual :=0
public temkill :=0
public nsec :=0
public optar :=0
public cpdrod :="\\rodrigo-pc\c\"
public cpdcam :="\\192.168.100.13\c\"
public assultm :=""
SET WRAP ON
SET ESCAPE ON
SET TALK OFF
SET BELL OFF
SET DATE BRIT
set scor off
set epoc to 1950
return

function edbase
         private exp :=space(15)
         save scre to tledb
         @ 10,1 clear to 33,69
         @ 10,1 to 33,69 double
         bs=space(48)
         set key 28 to abrearq
       set cursor on
         do while .t.
            if usebase("\tarefas\ultedit")=.t.
                index on dtos(data)+hora to indult descend
            go top
            @ 18,3 say "Últimos abertos:"
            @ 19,3 say arquivo
            skip
            @ 20,3 say arquivo
            skip
            @ 21,3 say arquivo
            skip
            @ 22,3 say arquivo
            skip
            @ 23,3 say arquivo
            skip
            @ 24,3 say arquivo
            skip
            @ 25,3 say arquivo
            skip
            @ 26,3 say arquivo
            skip
            @ 27,3 say arquivo
            skip
            @ 28,3 say arquivo
            skip
            @ 29,3 say arquivo
            skip
            @ 30,3 say arquivo
            skip
            @ 31,3 say arquivo
            skip
            @ 32,3 say arquivo
         endif
         use
            set key 24 to escbased
            bs=bs+space(10)
            @ 15,2 say "Para listar arquivos, tecle F1; para escolher entre os"
         @ 16,2 say "últimos arquivos abertos, tecle seta para baixo"
            @ 11,2 say "Pasta atual: "+curdir()
            @ 13,2 say "Arquivo:"get bs
            read
         set key 24 to
         set key 28 to
         set key -1 to
         if lastkey()=27
            exit
         endif
       if !file("\tarefas\ultedit.dbf")
            nvestr := {}
            aadd(nvestr,{"arquivo","C", 40, 0})
            aadd(nvestr,{"data","D", 08, 0})
            aadd(nvestr,{"hora","C", 05, 0})
            dbcreate("ultedit",nvestr)
       endif
       if usebase("\tarefas\ultedit")=.t.
          locate for arquivo=bs
         if !found()
            append blank
            rlbs()
               replace arquivo with bs
         endif
         replace data with date()
         replace hora with time()
        endif
         if us#"I"
            ?us
            if usebase(ativ)=.t.
            append blank
         rlbs()
            replace data with date()
            replace hora with time()
            replace acao with "Edbase"
            replace assunto with bs
         endif
            use
         endif
         if lastkey()#27
            if "\\promotor"$bs .and. !file("\\promotor\c\lixo\copypen.dbf")
               tone(261.7,3)
               clear
               @ 5,5 say "Atenção: não alterar este arquivo hoje"
               inkey(10)
               tone(261.7,22)
               inkey(5)
            endif
            bs=alltrim(bs)
            if !file((bs)+".dbf")
               @ 20,5 say "Arquivo inexistente"
               inkey(5)
               rest scre from tledb
               loop
            endif
            __run("copy "+bs+".dbf \lixo")         
            if usebase(bs,"S")=.T.
               keysec()
               cls
               @ 0,1 say "Arquivo em edição: "+alias()
            @ maxrow(),1 say "Alt-P-procura/filtra; Alt-M-mostra estrutura; F2-acresce registros; Alt-C-conta registros"
               keyb chr(20)
            dbedit(2,1,maxrow()-2,maxcol(),,"altbase")
            

*               pack
            
            else
               @ maxrow()-1,5 say "Abandonado"
               inkey(15)
            endif
            exit
         endif
         enddo
         rest scre from tledb
         use
return

function rlbs
         local nrrl :=0
       if empty(alias())
          return .f.
        endif
       do while .t.
          if rlock()=.t.
            exit
         else
            nrrl++
            @ maxrow()-1,1 say "Aguarde tentativa de reservar o registro da base "+alias()+" para uso privado ("+alltrim(str(nrrl))+")"
            inkey(5)
            if nrrl>50
               return .f.
            endif
         endif
         enddo
return .t.

function ANSI(cTxt) // 1 texto a ser convertido para o padrÒo ANSI

local I
local aTab
local nCod

aTab:= {;
199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197,;
201,230,198,244,246,242,251,249,255,214,220,248,163,216,215,131,;
225,237,243,250,241,209,170,176,191,174,172,189,188,161,171,187,;
35, 35, 35,124, 43,193,194,192,169, 43,124, 43, 43,162,165, 43,;
43, 43, 43, 43, 45, 43,227,195, 43, 43, 43, 43, 43, 61, 43,164,;
240,208,202,203,200,185,205,206,207, 43, 43, 35, 35,166,204, 35,;
211,223,212,210,245,213,181,254,222,218,219,217,253,221,175,180,;
173,177, 61,190,182,167,247,184,186,168,183,185,179,178, 35, 32 }

for I:= 1 to Len(cTxt)
nCod:= ASC(SubStr(cTxt,I,1))

if nCod >= 128
cTxt:= Stuff(cTxt,I,1,Chr(aTab[nCod -127]))
endif
next
return cTxt

function verint
         local nFlags := 0, lRet := .f.
         erase lista.log
         pasta=ptftp+"tarefas/inacio"
         if listaftp(ptftp)=.t.
          return .t.
       else
**********************************************
* Compilar: hbmk2 demo.prg -lhbmisc
**********************************************
            if CallDll32( "InternetGetConnectedState", "WININET.DLL", @nFlags, 0 ) == 1
            return .t.
         else
             return .f.
         endif
       endif
return

function abrearq
         set key 24 to
         save scre to tlabarq
         Public aFiles[ADIR("*.DBF")]
         ADIR("*.DBF",aFiles)
         @ 6,24 to 21,65 double
         aSort(aFiles)
         nArquivo:=Achoice(7,25,20,64,aFiles)
         if lastkey()=27
            return .f.
         endif
         Cls
         bs=aFiles[nArquivo]
         set key 24 to escbased
         rest scre from tlabarq
return

FUNCTION escbased
         set key 24 to
         if usebase("\tarefas\ultedit")=.t.
          index on dtos(data)+hora to indult descend
          private v1[1]
         v1[1]="Arquivo"
         @ 19,0 clear to 33,45
          dbedit(19,3,32,43,v1)
         bs=arquivo
        endif
       @ 19,0 clear to 33,45
RETURN

Function listaftp(pasta)
        ftpproto ="ftp://" //posthilit">ftp://"
        ftpserver = ftps // posthilit">ftp.servidor.com.br"  endereço de ="posthilit">FTP</span> do site
        ftpuser = "inaciobr"   //Usuário da conta ="posthilit">FTP</span>
        curl:=ftpproto+ftpuser+":"+snhftp+"@"+ftpserver
        oUrl:= turl():new(curl)
        oCred:= tIPCredentials()
        oFtp:= tipclientftp():NEW(oUrl,.T.)
        oFTP:nConnTimeout := 20000
        oFTP:bUsePasv     := .T.
       pasta=alltrim(pasta)
       nTentativas=0
       do while .t.
           IF oFTP:Open()
            exit
         else
            nTentativas++
            @ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
            @ maxrow()-1,1 say "Tentando abrir o FTP (listaftp)"
            if us="I" .and. (nTentativas=3 .or. nTentativas>8)
               tone(261.7,nTentativas)
            endif
            inkey(28)
            if nTentativas>10 .or. usooff="S"
                  mandmail1("","Não abriu o FTP no listaftp")      
                  return .f.      
            endif
         endif
       enddo
            nTentativas := 0
         oFTP:Cwd( "" )
            While oFTP:Cwd(pasta)=.f.
               oFTP:pwd()
               if us="I"
                 @ maxrow()-1,1 say "Não conseguiu abrir a pasta do FTP; tentando novamente"
                     ?oftp:creply
                if nTentativas>3
                   tone(261.7,nTentativas)
                endif
              endif
                  InKey( 11.5 ) // aguarda 1/2 segundo
                  nTentativas++
                  If nTentativas > 10 // após 3 tentativas p.e.
                     if us="I"
                        cls
                        ?"Conferir pasta: "+pasta
                        tone(261.7,33)
                     endif
                     mandmail1("","Conferir pasta no listaftp: "+pasta+"; "+oFTP:cReply)
                     return .f.
                  EndIf
            EndDo      
         
         nTentativas=0
         do while .t.
               clista:=oFTP:List()
               if valtype(clista)="U"
               nTentativas++
              if us="I" .and. nTentativas>3
                 @ maxrow()-1,1 say "Clista está indefinida no listaftp"
                tone(261.7,nTentativas)
                inkey(10)
              endif
              if nTentativas>10
                     mandmail1("","Clista indefinido com valtype")
                 return .f.
               endif
            else
               exit
            endif
         enddo
         
         if usebase("arqbx","S")=.t.
            dele all
            pack
            clista=substr(clista,40)
            do while .t.
                  if empty(clista) .or. at("www.ina",clista)=1
                 exit
                  endif
                  nrfinal=at(".",substr(clista,1,10))+3
              if at(".",substr(clista,nrfinal,5))=0
                     append blank
                     repl nome with substr(clista,1,nrfinal)
                  else
                     nrfinal=nrfinal+4
                  endif                  
              clista=substr(clista,nrfinal+42)
              if len(clista)<5
                 exit
              endif
            enddo
            else
            if usebase(ativ)
               append blank
              repl data with date()
              repl hora with time()
              repl acao with "Ñ abre"
              repl nrtarefa with "arqbx"
              repl assunto with "na listaftp"
            endif
            use
            return .f.
         ENDIF
         oFTP:cwd( "" )
            oFTP:Close()
Return .t.



Estou compilando com este bat:

@echo off >nul

cd\hb32\bin
del *.prg
del *.tds
del *.c
del *.ppo
del *.obj
del *.map
del tagenda.exe*
copy \prg\tagenda.prg
copy \agenda\tag.hbp

pause

hbmk2 tag.hbp

pause

copy tagenda.exe \agenda

cd\agenda
pause
tagenda.exe


E com este .hbp:

# coloque aqui suas libs, precedidas pela letra "l" (minúscula):
-lxhb
-lhbwin
-lhbtip
-lhbct
-lhbHPdf
-lhbZebra
-lhbmisc
rddsql.hbc
sddodbc.hbc

# coloque aqui os parâmetros de compilação:
-quiet
-jobs=4
-oTAGENDA

# coloque aqui seus arquivos PRGs:
TAGENDA.PRG


Está compilando, e está conectando no banco de dados, mas daí dá erro no dbf:

Error DBF/0 Operação não suportada


O erro está dando nesta linha:

                index on dtos(data)+hora to indult descend
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor Toledo » 27 Mai 2014 14:10

Inácio, você tem que entender que você está trabalhando com dois RDDs diferentes, então quando for usar algum comando para um dos dois tipos de arquivos (DBF ou MySQL) o RDD correspondente tem que estar setado.

cjp escreveu:Está compilando, e está conectando no banco de dados, mas daí dá erro no dbf:

Error DBF/0 Operação não suportada

O erro está dando nesta linha:

index on dtos(data)+hora to indult descend

Olhando o seu PRG, notei que a linha do index acima é encontrada duas vezes no seu código, uma na função edbase() que é chamada através das teclas ALT+E e também na função escbased() que é chamada com Seta para baixo.
Então se você estiver dentro do browse do arquivo MySQL e pressionando ALT+E para chamar a função edbase(), com certeza vai ocorrer um erro, pois neste ponto o RDD setado é o SQLMIX e a função edbase() vai tentar abrir um arquivo DBF. Neste caso, você terá que anular o ALT+E quando entrar no browse do MySQL ou setar o RDD DBF quando chamar a função edbase().

Outra coisa, notei que você usa arquivos de índices NTX, então neste caso seria melhor setar o RDD DBFNTX. Neste caso troque no REQUEST o _DBF por DBFNTX e no RDDSETDEFAULT() mude também o "DBF" para "DBFNTX".

Abraços,
Toledo - Clipper On Line
toledo@pctoledo.com.br
Harbour 3.2/MiniGui/HwGui
Faça uma doação para o fórum, clique neste link: http://www.pctoledo.com.br/doacao
Avatar de usuário

Toledo
Administrador

Administrador
 
Mensagens: 3038
Data de registro: 22 Jul 2003 18:39
Cidade/Estado: Araçatuba - SP
Curtiu: 263 vezes
Mens.Curtidas: 258 vezes

Erro em ANNOUNCE RDDSYS / SQL

Mensagempor cjp » 27 Mai 2014 14:39

Eu entendo, Toledo. Mas não estou chamando o ALT-E de dentro do browse não. Eu estou testando chamar o ALT-E antes e depois do browse. Mas é sem dúvida um bom alerta para eu tomar cuidado depois, para o usuário não fazer isso.

Com o DBFNTX agora deu certo, funcionou perfeitamente, neste teste que eu fiz.

Mas, estranhamente, ainda não está funcionando no meu programa normal. Mudei também lá para o DBFNTX, mas ainda está dando erro na linha nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server...

Não consigo entender o porque funciona em um e não funciona no outro. Já dei uma vasculhada em todo o programa, não achei nada que se relacionasse com o RDD neste programa, até porque eu nunca tinha usado isso antes.
Inacio de Carvalho Neto
cjp
Usuário Nível 6

Usuário Nível 6
 
Mensagens: 1527
Data de registro: 19 Nov 2010 21:29
Cidade/Estado: paraná
Curtiu: 10 vezes
Mens.Curtidas: 20 vezes

Próximo



Retornar para SQL

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 7 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro