Clipper On Line • Ver Tópico - Tutorial de ADO

Tutorial de ADO

Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.

Moderador: Moderadores

 

Tutorial de ADO

Mensagempor esbasso » 27 Ago 2015 13:16

Uma pequena contribuição para o tutorial muito bom
Um exemplo de conexão
E uma rotina para converter o recordset gerado para uma tabela dbf

#include "adordd.ch"
#define DBI_FULLPATH             10

REQUEST DBFCDX, DBFFPT //, SDDODBC // SQLRDD,

Function Main
local oConn, oComm, oRs, oErr
local i:=0, j, nr
local cConn

SET CENTURY ON

  lcServer  := "localhost"
  cPORTA    := "5432"
  lcBd      := "Silabor"           // impportante aqui, maiscula e minuscula diferem
  lcUSUARIO := "root"
  lcSENHA   := "SENHA"

cConn := "DRIVER={"+"PostgreSQL UNICODE"+"};" +;
  "SERVER="+lcServer +";" +;
  "UID="+lcUsuario +";" +;
  "PWD="+lcSenha +";" +;
  "Trusted_Connection=Yes ;" +;
  "PORT="+cPorta + ";" +;
  "DATABASE="+lcBd +";"+;
  "BoolsAsChar=0"

Try
  oConn := CreateObject( "ADODB.Connection" )
  with object oConn
     :ConnectionString:=cConn
     :Open()
  end
  oComm := CreateObject( "ADODB.Command" )
  with object oComm
      :CommandText:="SELECT * FROM weblaudos"
      :CommandType:=adCmdText
      :ActiveConnection := oConn
      oRs := :Execute()
      RecordSet2Dbf( oRs, "rsdbf" )
      *- MOSTRAR AQUI OS REGISTROS
  end
  oRs:Close()
  oConn:Close()
  oRs:=NIL
  oComm:=NIL
  oConn:=NIL
catch oErr
     msginfo( "Error: " + oErr:Operation + " " + oErr:Description)
end
msginfo( "end")

   IF SELECT( "rsdbf" ) > 0
      cDbf := &("rsdbf")->( DBINFO(DBI_FULLPATH))
      ("rsdbf")->(DBCLOSEAREA())
      IF FILE( cDbf )
         DELETEFILE( cDbf )
      ENDIF
   ENDIF

RETURN NIL

FUNCTION RecordSet2Dbf( oRs, cAlias )
LOCAL aStruct := {}, aField
LOCAL cType, nLen, nDec
LOCAL cNometmp

   IF oRs = Nil
      RETURN NIL
   ENDIF
   cAlias := IIF( cAlias = Nil, "rsdbf", cAlias )
   With object oRs
      nr := :Fields:Count
      For i := 0 To nr-1
         nDec := 0
         DO CASE
         CASE :Fields[i]:Type IN { adBoolean} //11
           cType := "L"
           nLen := 1
         CASE :Fields[i]:Type IN { adDate, adDBDate }  //133
           cType := "D"
           nLen := 8
         CASE :Fields[i]:Type IN { adSmallInt ,adInteger,adBigInt, adTinyInt, adNumeric,;
                                   adVarNumeric, adSingle, adDouble, adCurrency, adDecimal }
               //131,139
           cType := "N"
           nDec := :Fields[i]:NumericScale
           nLen := Min( 10 + nDec, :Fields[i]:DefinedSize )

         OTHERWISE   //130, 134, 202 }
           cType := "C"
            nLen := :Fields[i]:DefinedSize
         ENDCASE
         aField := { :Fields[i]:Name , cType, nLen, nDec }
         AADD( aStruct, aField )
      NEXT
   END
   cNometmp := "_"+LEFT( LTRIM( STR( seconds() * HB_Random(10) + 1000, 14 ) ), 7 ) + ".DBF"
   DBCREATE( cNometmp, aStruct, "DBFCDX" )
   DBUseArea( .T., "DBFCDX", cNomeTmp, cAlias, .F. )
   With object oRs
     DO WHILE .NOT. :Eof()
        ( cAlias )->(DBAPPEND())
        For i := 0 To nr-1
          ccampo := :Fields[i]:Name
          xValue := :Fields[i]:Value
          IF :Fields[i]:Type IN { adDate, adDBDate } // DATA
             xVALUE := CTOD( "" )
             IF VALTYPE(:Fields[i]:Value) = "T"
                xvalue := STOD(LEFT( TtoS( :Fields[i]:Value ), 8 ))
             ELSE
                xvalue := STOD( :Fields[i]:Value )
             ENDIF
          ELSEIF :Fields[i]:Type IN { adDBTime } // TIME
             xVALUE := TRANSF(:Fields[i]:Value,"@R 99:99:99" )
          ENDIF
          ( cAlias )->&cCampo := xValue
        NEXT
        :MoveNext()
     ENDDO
   END
   RETURN cAlias

Luis Fernando Basso
Desenvolvedor VFP + XHARBOUR + HWGUI
lfbasso@gmail.com
http://www.engersoft.com.br
esbasso
Colaborador

Colaborador
 
Mensagens: 325
Data de registro: 24 Jan 2007 16:49
Cidade/Estado: CHAPECO/SC
Curtiu: 0 vez
Mens.Curtidas: 8 vezes

Tutorial de ADO

Mensagempor JoséQuintas » 02 Nov 2015 17:58

Só pra complementar:

Fields() é um objeto do "arquivo temporário". Contém a lista de campos, semelhante mas não igual a dbStruct()
É como se fosse um array, com o detalhe que começa em ZERO, e não em 1.
Fields(0):Name é o nome do primeiro campo (como se fosse fieldName() do Clipper/Harbour)
Fields(0):Value é o conteúdo (como se fosse FIeldGet() do Clipper/Harbour)
Também tem tamanho, tipo, decimais, etc., muito mais informações do que um dbStruct().

Teoricamente deveria servir pra ida e volta (ler e gravar).

Isto seria o equivalente do replace:

Fields(0):Value := "33333"


Mas na prática a coisa é mais complexa que isso.
Pra isso funcionar corretamente, depende da biblioteca ADO da Microsoft, e da biblioteca/driver do banco de dados.
Alguns "drivers" só mantiveram compatibilidade pra leitura, e parcial pra gravação.
Usando SQL sempre funciona.

Se tem acesso aos dados, à estrutura, aos tamanhos de campos, tipos, etc. converter teoricamente é simples: ler um e gravar o outro
Mas existem muitos tipos diferentes do DBF. Por exemplo, no MySQL existem diversos tipos numéricos: int, double, tyniint, smallint, mediumint, bigint, float, decimal

tem também uns tipos que não faço a menor idéia do conteúdo, por exemplo:
point, linestring, polygon, geometry, multipoint, multilinestring, multipolygon, geometrycollection

Por isso a conversão fica com um fonte grande, pra poder ajustar os tipos pra algo compatível com DBF: Numérico, Data, Caractere, etc.
De resto, é ler/gravar.

DO WHILE .NOT. oADOTemporario:Eof()
   APPEND BLANK
   FieldPut( 1, Fields(0):Value )
   FIeldPut( 2, FIelds(1):Value )
   oADOTemporario:MoveNext()
ENDDO


Fields() aceita como parâmetro um número ou o nome do campo.
Fields(0):Value ou Fields( "CODIGO" ):Value

Duas coisas que "pegam" muitos programadores:

Data - dependendo da base de dados, não existe data ZERO - a opção é deixar VAZIA.
Campo com conteúdo vazio - vazio é sem nada, com NULL (NIL no Clipper/Harbour).

Qualquer campo, mesmo numérico, se estiver vazio contém NIL

? Fields( "VALOR" ):Value * 0.1


A linha acima pode gerar erro.
Sim, porque o conteúdo de VALOR pode ser NIL, que não é número.

Com o tempo a gente vai criando nossa biblioteca, ou até classe, pra facilitar o uso, e reduzir código fonte.
No banco de dados pode existir a opção de definir um valor padrão: por exemplo gravar ZERO quando for número.

Tem biblioteca que faz essa conversão automaticamente.
Mas é bom saber que isso existe, assim, caso a biblioteca não esteja preparada pra ler dados gravados por outros programas, sabe aonde pode ser o problema.

É tudo questão de se acostumar.
Existem tipos de campos que não existem nos DBFs, então nada mais comum do que aprender novos tipos de campos, nem que seja só pra saber que existem.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18008
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Tutorial de ADO

Mensagempor asimoes » 19 Mar 2016 22:38

Quintas,

Boa noite,

Existe algum utilitário para subir uma tabela dbf pro mysql?
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor JoséQuintas » 20 Mar 2016 08:31

Deve existir, mas você consegue fazer algo fácil direto em Harbour.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18008
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Tutorial de ADO

Mensagempor JoséQuintas » 20 Mar 2016 08:51

Apenas pra dar uma idéia:

CREATE TABELA ( CAMPO1 CHAR(10), CAMPO2 INT(11), CAMPO3 DATE )


FUNCTION Cria( cNomeDbf )

USE ( cNomeDbf )
cSql := "CREATE TABLE " + cNomeDbf + " ( "
oStru := dbStruct()
FOR nCont = 1 TO Len( oStru )
   cTipoSql := ""
   DO CASE
   CASE oStru[ DBF_TYPE ) == "C"
      cTipoSql := "CHAR(" + Ltrim( Str( oStru[ DBF_LEN ] ) ) + ")"
   CASE oStru[ DBF_TYPE ) == "N"
      IF oStru[ DBF_DEC ] == 0
         cTipoSql := "INT(" + Ltrim( Str( oStru[ DBF_LEN ] ) ) + ")"
      ELSE
         cTipoSql := "DOUBLE(" + Ltrim( Str( oStru[ DBF_LEN ] ) ) + "," + Ltrim( Str( oStru[ DBF_DEC ] ) ) + ")"
      ENDIF
   CASE oStru[ DBF_TYPE ] == "D"
      cTipoSql := "DATE"
   // etc
   ENDCASE
   cSql += oStru[ DBF_NAME ] + " " + cTipoSql + ", "
NEXT
USE
RETURN cSql
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18008
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Tutorial de ADO

Mensagempor JoséQuintas » 20 Mar 2016 09:01

Pra dar idéia da gravação dos campos:

INSERT INTO NOMETABELA ( "string", 123.5, '2016-03-20', NULL )


DO WHILE .NOT. Eof()
   cSql := "INSERT INTO " + cNomeDbf + "("
   FOR nCont = 1 TO FCount()
       cSql = cSql + ValueSql( FieldGet( nCont ) ) + ","
   NEXT
   cnMySql:Execute( cSql )
   SKIP
ENDDO
RETURN

FUNCTION ValueSql( xValue )
   DO CASE
   CASE ValType( xValue ) == "C" ; RETURN ['] + xValue + [']
   CASE ValType( xValue ) == "N" ; RETURN Ltrim( Str( xValue ) )
   CASE ValType[ xValue ] == "D" ; RETURN iif( Empty( xValue ), "NULL", ['] + Transform( Dtos( xValue ), "@R 9999-99-99" ) + ['] )
   ENDCASE
   RETURN NIL // se chegar aqui dá erro, então é um tipo não previsto


Nota:
criei durante a digitação, é só pra dar uma idéia mesmo.
Talvez seja necessário converter strings, trocando codepage de caracteres, ou ajustando caracteres especiais como aspas.

No geral, é mais rápido e interessante criar uma rotina de converter mesmo, assim pode até confirmar alguma necessidade extra de conversão.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18008
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Tutorial de ADO

Mensagempor asimoes » 20 Mar 2016 11:59

Quintas,

No seu exemplo faltou somente tratar campo lógico.
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor JoséQuintas » 20 Mar 2016 12:46

Faltou até mais que isso.
Campo memo, melhor usar TEXT ao invés de VARCHAR.
Campo lógico... não uso então nem me preocupei em verificar, mas acho que se transforma em 0 ou 1
No Harbour existem os campos datetime, incremental, etc.

Como eu disse, é só um exemplo básico, mas é um bom ponto de partida pra dar idéia de como fazer.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18008
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Tutorial de ADO

Mensagempor JoséQuintas » 20 Mar 2016 12:54

Dependendo de como estiver configurado o MySQL, pode aceitar data zerada ou não. '0000-00-00' ou NULL.
Eu preferi deixar no jeito mais usado, que é não aceitando data zerada.

Já não lembro como era o Advantage Database Local, se com DBF usava data zerada ou nulo.
Só lembro que os comandos eram no mesmo padrão do SQL Server.
De qualquer forma, era só tratar na função ValueSql() e tudo resolvido, igual pra todos.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18008
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Tutorial de ADO

Mensagempor asimoes » 20 Mar 2016 18:41

Pessoal,

Eu estou adaptando um programa de carga que eu fiz para oracle (funcionando ok) usando adodb, agora para um servidor MySQL, estou tendo
problema com campo tipo date, o dbf que eu estou testando tem data nula e nestes campos nulos está acontecendo o erro abaixo:

Incorrect date value: '-27860-160'

FOR EACH oElemento2 IN aTheDBF

    nIndex := oElemento2:__enumIndex()
    lLast  := oElemento2:__enumIsLast()

    cNomeCampo:=Upper(oElemento2[1])

    cTheValue := &( oElemento2[1] )

    IF oElemento2[2] = "D"
       IF Empty(cTheValue)
          cTheValue:=Nil
       ENDIF
    ENDIF
     
    IF oElemento2[2] $ "NCM"
       IF Empty(cTheValue)
          //cTheValue:=Nil
       ENDIF
    ENDIF

    DO CASE
    CASE oElemento2[2] = "C"
         IF cTheValue <> NIL
            cTheValue:=RTRIM(cTheValue)
         ENDIF
    ENDCASE

    cEspaco:=IF( nIndex > 1, Space(nEspaco), "")

    DO CASE
    CASE oElemento2[2] = "N"
         cQuery += "?"+IF(!lLast, ", ", "")
         IF oElemento2[4] = 0
            Param0 := oCommand:CreateParameter(cNomeCampo, adInteger, adParamInput, oElemento2[3], cTheValue)
         ELSE
            Param0 := oCommand:CreateParameter(cNomeCampo, adNumeric, adParamInput, oElemento2[3], cTheValue)
         ENDIF
         oCommand:Parameters:Append( Param0)
    CASE oElemento2[2] = "D"
         //altd()
         cQuery += "?"+IF(!lLast, ", ", "")
         Param1 := oCommand:CreateParameter(cNomeCampo, adDate, adParamInput, oElemento2[3], cTheValue)
         oCommand:Parameters:Append( Param1)
    CASE oElemento2[2] = "L"
         cQuery += "?"+IF(!lLast, ", ", "")
         cTheValue:=IF(cTheValue, "T", "F")
         Param2 := oCommand:CreateParameter(cNomeCampo, adVarChar, adParamInput, oElemento2[3], cTheValue)
         oCommand:Parameters:Append( Param2)
    CASE oElemento2[2] = "C"
         cQuery += "?"+IF(!lLast, ", ", "")
         Param3 := oCommand:CreateParameter(cNomeCampo, adVarChar, adParamInput, oElemento2[3], cTheValue)
         oCommand:Parameters:Append( Param3)
    CASE oElemento2[2] = "M"
         cQuery += "?"+IF(!lLast, ", ", "")
         Param4 := oCommand:CreateParameter(cNomeCampo, adLongVarChar, adParamInput, Len(IF(cTheValue=Nil, oElemento2[1], cTheValue)), cTheValue)
         oCommand:Parameters:Append( Param4)
    ENDCASE
NEXT
cQuery+= ")"
oCommand:CommandText:= cQuery
Try
   oCommand:Execute()
Catch oErro
   nCod_ret := oErro:SubCode
   cErro    := oErro:Description
End

oConnection:Close()


Segue o fonte completo para analise:
*********************************************************************
* Programa : ADORADBF                                               *
* Autor    : Alexandre Simäes                                       *
* Data     : 23/03/2012                                             *
* Descricao: Carga de uma tabela DBF no Oracle                      *
*            ConexÆo via ADODB                                      *
*********************************************************************
#include "inkey.ch"
#include "setcurs.ch"
#include "error.ch"
#include "achoice.ch"
#include "fileio.ch"
#include "common.ch"
#include "dbinfo.ch"
#include "hbver.ch"
#include "hbdyn.ch"
#include "wvtwin.ch"
#include "hbgtinfo.ch"
#include "hbgtwvg.ch"
#include "wvgparts.ch"
#include "hbcompat.ch"
#include "windows.ch"
#include "directry.ch"
#include "adordd.ch"
#include "set.ch"
#include "common.ch"

#command SET OPTIMIZE <x:ON,OFF,&>   => Set( _SET_OPTIMIZE, <(x)> )
#command SET AUTOPEN <x:ON,OFF,&>    => Set( _SET_AUTOPEN, <(x)> )
#command SET DBFLOCKSCHEME TO <x>    => Set( _SET_DBFLOCKSCHEME, <x> )

FUNCTION Main(cPastaDBF)
   hb_Default(@cPastaDBF, "")
   Carga_MySql(cPastaDBF)
RETURN Nil

*-------------------------------------------------------------------------
FUNCTION Carga_MySql(cPasta)
*-------------------------------------------------------------------------
LOCAL   oElemento1, oElemento2, oErro
PRIVATE cPastaPesquisa:=hb_DirBase()
PUBLIC  oConnection

   QualConexao()

   oRecordSet:=Nil
   CriaObjetoRecordSet(@oRecordSet)
   oRecordSet:CursorType := adOpenDynamic //adUseClient //adOpenDynamic
   oRecordSet:ActiveConnection:=oConnection
   oCommand:=IniciaCommand()

   SetCursor(0)

   IF Empty(cPasta)
      DO WHILE Empty(cPasta)
         cPasta:=GetFolder( "Informe a pasta dos dbfs.", cPastaPesquisa ) //SelectFolder("Informe a pasta dos dbfs.")
         IF Empty(cPasta)
            IF MsgNaoSim("Nenhuma pasta foi selecionada, abandonar?")
               QUIT
            ENDIF
         ELSE
            IF MsgNaoSim("Confirma a pasta "+cPasta+ " para migra‡Æo?")
               EXIT
            ELSE
               cPasta:=""
               LOOP
            ENDIF
         ENDIF
      ENDDO
   ENDIF

   SET DEFAULT TO &cPasta.

   IF !MsgNaoSim("Inicia a carga?", "Aten‡Æo")
      QUIT
   ENDIF


   aDBFA:={}
   aDBFB:={}
   aDBF :={}

   fErase("dbf2mysql.txt")
   fErase("erromysql.txt")
   
   MsgIni("Aguarde...")

   aDir:=Directory(cPasta+HB_PS()+"*.DBF")

   aSort( aDir ,,, {|x,y| y[1] > x[1] } )

   IF Len(aDir) > 0
      aEval(aDir, {|f| aAdd(aDBF, Upper(f[F_NAME]))})
   ENDIF

   MsgFim()

   IF Len(aDBF) > 0

      @ 08, 01 SAY PADR("Pasta dos dbfs", 39)+": "                          COLOR "W+/N"
       
      @ 08, 42 SAY PADL(cPasta, MaxCol()-42)                                COLOR "W+/N"
       
      @ 09, 01 SAY PADR("Total de tabela(s)", 39)+": "                      COLOR "W+/N"
       
      @ 09, 42 SAY PADL(Transform(Len(aDBF), "9999"), MaxCol()-42)          COLOR "W+/N"
       
      @ 10, 01 SAY PADR("Hora inicio", 39)+": "                             COLOR "W+/N"
       
      @ 10, 42 SAY PADL(Time(), MaxCol()-42)                                COLOR "W+/N"
       
      @ 11, 01 SAY PADR("Hora t‚rmino", 39)+": "                            COLOR "W+/N"
       
      @ 12, 01 SAY PADR("Processando tabela n§", 39)+": "                   COLOR "W+/N"
       
      @ 13, 01 SAY PADR("Processando registros da tabela", 39)+": "         COLOR "W+/N"
       
      @ 14, 01 SAY PADR("Total de registros", 39)+": "                      COLOR "W+/N"
       
      @ 15, 01 SAY PADR("Tempo decorrido", 39)+": "                         COLOR "W+/N"
       
      @ 16, 01 SAY PADR("% realizado", 39)+": "                             COLOR "W+/N"
       
      @ 17, 01 SAY PADR("Registro corrente", 39)+": "                       COLOR "W+/N"
       
      @ 18, 01 SAY PADR("Total acumulado de registros", 39)+": "            COLOR "W+/N"

      cData:=HB_DtoC(Date(), "DDMM")

      fErase(cData+"adomysql.log")

      EscreveLinha("Hora Inicio : "+HB_DtoC(Date(), "DD/MM/YYYY")+" "+Time(), cData+"adomysql.log")

      AbreLinha(1, cData+"adomysql.log")

      nSecIni:=Seconds()

      TRY
         FOR EACH oElemento IN aDBF
            cAlias:=StrTran(Lower(oElemento), ".dbf", "")
            cQuery:="DROP TABLE "+cAlias
            oConnection:Execute( cQuery )
         NEXT
      CATCH oErr
      END

      nTotalGeralRegistros:=0

      FOR EACH oElemento1 IN aDBF

         cTabelaDBF:=oElemento1

         cAlias:=StrTran(Upper(oElemento1), ".DBF")

         USE &(cAlias) ALIAS &cAlias.

         aTheDBF := DbStruct()

         @ 12, 42 CLEAR TO 12, MaxCol()

         @ 17, 42 CLEAR TO 22, MaxCol()

         @ 12, 42 SAY PADL(Transform(oElemento1:__enumIndex(), "9999"), MaxCol()-42)  COLOR "W+/N"

         @ 13, 42 SAY PADL(cAlias, MaxCol()-42)                              COLOR "W+/N"

         //SET DATE FORMAT TO "YYYY-MM-DD"
         
         TRY
            cQuery:='DROP TABLE '+cAlias
            oConnection:Execute( cQuery )
         CATCH
         END

         //cQuery:='ALTER SESSION SET NLS_LANGUAGE = "PORTUGUESE"'
         //oConnection:Execute( cQuery )

         //cQuery:='ALTER SESSION SET NLS_TERRITORY = "BRAZIL"'
         //oConnection:Execute( cQuery )

         //altd()
         TRY
            cQuery  := "CREATE TABLE "+cAlias+ " ( "
            nEspaco := Len(cQuery)
            FOR EACH oElemento2 IN aTheDBF
               cNomeCampo:=Upper(oElemento2[1])
//               IF AllTrim(cNomeCampo) == "DESC"
//                  cNomeCampo:='"'+'DESC'+'"'
//               ENDIF
//               IF AllTrim(cNomeCampo) == "DATA"
//                  cNomeCampo:='"'+'DATA'+'"'
//               ENDIF
               nIndex := oElemento2:__enumIndex()
               lLast  := oElemento2:__enumIsLast()
               DO CASE
               CASE oElemento2[2] = "C"
                    cQuery+=IF(nIndex > 1,;
                               Space(nEspaco), "")+PADR(cNomeCampo, 10)+" varchar("+AllTrim(Str(oElemento2[3]))+") NULL"+IF(!lLast, ",", " )")+HB_EOL()
               CASE oElemento2[2] = "N"
                    cTamanho:=AllTrim(Str(oElemento2[3]))
                    cDecimal:=AllTrim(Str(oElemento2[4]))
                    IF oElemento2[4] = 0
                       cQuery+=IF(nIndex > 1,;
                               Space(nEspaco), "")+PADR(cNomeCampo, 10)+" int("+cTamanho+") NULL"+IF(!lLast, ",", " )")+HB_EOL()                   
                    ELSE
                       cQuery+=IF(nIndex > 1,;
                               Space(nEspaco), "")+PADR(cNomeCampo, 10)+" double("+cTamanho+","+cDecimal+") NULL"+IF(!lLast, ",", " )")+HB_EOL()                   
                    ENDIF
               CASE oElemento2[2] = "D"
                    cQuery+=IF(nIndex > 1,;
                               Space(nEspaco), "")+PADR(cNomeCampo, 10)+" date NULL DEFAULT NULL"+IF(!lLast, ",", " )")+HB_EOL()
               CASE oElemento2[2] = "L"
                   //altd()
                    cQuery+=IF(nIndex > 1,;
                               Space(nEspaco), "")+PADR(cNomeCampo, 10)+" char(1) NOT NULL DEFAULT 'F'"+IF(!lLast, ",", " )")+HB_EOL()
               CASE oElemento2[2] = "M"
                    cQuery+=IF(nIndex > 1,;
                               Space(nEspaco), "")+PADR(cNomeCampo, 10)+" clob NULL"+IF(!lLast, ",", " )")+HB_EOL()
               ENDCASE
            NEXT

            fErase("querytable.txt")

            EscreveLinha(cQuery, "querytable.txt")

            oConnection:Execute( cQuery ) // Cria a tabela se nÆo existe

         CATCH oErr
            hwg_MsgStop("Erro criando a tabela "+cAlias, "Erro")
         END

         TRY
            cTheQuery:="TRUNCATE TABLE "+cAlias
            oConnection:Execute( cTheQuery )
         CATCH oErr
         END
           
            nTotalRegistros:=0

            &(Alias())->(DbEval({||nTotalRegistros++}, {||!&(Alias())->(Deleted()) .AND. !&(Alias())->(Eof())}))

            &(Alias())->(DbGoTop())

            nTotalGeralRegistros += nTotalRegistros

            @ 14, 42 SAY PADL(Transform(nTotalRegistros, "999999999"), MaxCol()-42) COLOR "W+/N"

            @ 18, 42 SAY PADL(Transform(nTotalGeralRegistros, "999999999999999999"), MaxCol()-42) COLOR "W+/N"

            cQueryLeft := "INSERT INTO "+cAlias+" ("

            nEspaco:=Len(cQueryLeft)

            FOR EACH oElemento2 IN aTheDBF
                nIndex := oElemento2:__enumIndex()
                lLast  := oElemento2:__enumIsLast()
                cNomeCampo := Upper(oElemento2[1])

                cQueryLeft += IF(nIndex > 1,;
                                 Space(nEspaco), "")+PADR(cNomeCampo, 10)+IF(!lLast, ", ", ")")+HB_EOL()
            NEXT

            nPosicaoVirgula := RAT(',', cQueryLeft)

            cQueryLeft      += " VALUES ("

            nEspaco         := Len(cQueryLeft)-RAT( " ) VALUES (", cQueryLeft )+33

            nPosicaoVirgula := RAT(',', cQueryLeft)

            cValorInsert    := ""

            TermoEspecial(0, nTotalRegistros)

            nTermo:=0

            EscreveLinha("Tabela : "+PADL(Alias(), 10)+" iniciado  as: "+Time(), "dbf2mysql.txt")

            AbreLinha(1, "dbf2mysql.txt")

            oConnection:BeginTrans()

            DO WHILE !&(Alias())->(Eof())

               TermoEspecial(++nTermo)

               @ 17, 42 SAY PADL(Transform(nTermo, "999999999"), MaxCol()-42) COLOR "W+/N"

               cQuery := cQueryLeft

               FOR EACH oElemento2 IN aTheDBF

                  nIndex := oElemento2:__enumIndex()
                  lLast  := oElemento2:__enumIsLast()

                  @ 15, 42 SAY PADL(TsTring(Seconds()-nSecIni), MaxCol()-42) COLOR "W+/N"

                  cNomeCampo:=Upper(oElemento2[1])

                  cTheValue := &( oElemento2[1] )

                  IF oElemento2[2] = "D"
                     IF Empty(cTheValue)
                        cTheValue:=Nil
                     ENDIF
                  ENDIF
                   
                  IF oElemento2[2] $ "NCM"
                     IF Empty(cTheValue)
                        //cTheValue:=Nil
                     ENDIF
                  ENDIF

                  DO CASE
                  CASE oElemento2[2] = "C"
                       IF cTheValue <> NIL
                          cTheValue:=RTRIM(cTheValue)
                       ENDIF
                  ENDCASE

                  cEspaco:=IF( nIndex > 1, Space(nEspaco), "")

                  DO CASE
                  CASE oElemento2[2] = "N"
                       cQuery += "?"+IF(!lLast, ", ", "")
                       IF oElemento2[4] = 0
                          Param0 := oCommand:CreateParameter(cNomeCampo, adInteger, adParamInput, oElemento2[3], cTheValue)
                       ELSE
                          Param0 := oCommand:CreateParameter(cNomeCampo, adNumeric, adParamInput, oElemento2[3], cTheValue)
                       ENDIF
                       oCommand:Parameters:Append( Param0)
                  CASE oElemento2[2] = "D"
                       //altd()
                       cQuery += "?"+IF(!lLast, ", ", "")
                         Param1 := oCommand:CreateParameter(cNomeCampo, adDate, adParamInput, oElemento2[3], cTheValue)
                       oCommand:Parameters:Append( Param1)
                  CASE oElemento2[2] = "L"
                       cQuery += "?"+IF(!lLast, ", ", "")
                       cTheValue:=IF(cTheValue, "T", "F")
                       Param2 := oCommand:CreateParameter(cNomeCampo, adVarChar, adParamInput, oElemento2[3], cTheValue)
                       oCommand:Parameters:Append( Param2)
                  CASE oElemento2[2] = "C"
                       cQuery += "?"+IF(!lLast, ", ", "")
                       Param3 := oCommand:CreateParameter(cNomeCampo, adVarChar, adParamInput, oElemento2[3], cTheValue)
                       oCommand:Parameters:Append( Param3)
                  CASE oElemento2[2] = "M"
                       cQuery += "?"+IF(!lLast, ", ", "")
                       Param4 := oCommand:CreateParameter(cNomeCampo, adLongVarChar, adParamInput, Len(IF(cTheValue=Nil, oElemento2[1], cTheValue)), cTheValue)
                       oCommand:Parameters:Append( Param4)
                  ENDCASE
                  //InKeyGui(2)
               NEXT

               //nPosicaoVirgula:=RAT(',', cQuery)

               cQuery+= ")"//SubStr(cQuery, 1, nPosicaoVirgula - 1)+" )"

               //hwg_MsgInfo(cQuery)
               
               fErase("queryvalor.txt")

               fErase("queryinsert.txt")

               EscreveLinha(cValorInsert, "queryvalor.txt")

               EscreveLinha(cQuery, "queryinsert.txt")

               //InkeyGui(5)
               
               oCommand:CommandText:= cQuery

               Try
                  oCommand:Execute()
               Catch oErro
               
                  nCod_ret := oErro:SubCode
                  cErro    := oErro:Description
                  //hwg_MsgInfo(cErro)
                  EscreveLinha("Erro: "+hb_ntos(&(Alias())->(Recno()))+" "+cErro+hb_Eol(), "erromysql.txt")
               End
               //IF MOD(&(Alias())->(RecNo()),2000) = 0
               //   oConnection:CommitTrans()
               //   @17,01 SAY PADR("Commit",39)            COLOR "W+/N"
               //   oConnection:BeginTrans()
               //   @17,01 SAY PADR("Begin Transaction",39) COLOR "W+/N"
               //ENDIF

               oCommand:=IniciaCommand()

               Param0:=Nil
               Param1:=Nil
               Param2:=Nil
               Param3:=Nil
               Param4:=Nil

               IF Mod(nTermo, 2000) = 0
                  oConnection:CommitTrans()
                  @ 19, 01 SAY PADR("Commit Transaction "+Time(), 39) COLOR "W+/N"
                  oConnection:BeginTrans()
                  @ 20, 01 SAY PADR("Begin Transaction  "+Time(), 39) COLOR "W+/N"
               ENDIF

               &(Alias())->(DbSkip())

            ENDDO

            oConnection:CommitTrans()

            EscreveLinha("Tabela : "+PADL(Alias(), 10)+" terminado as: "+Time(), "dbf2mysql.txt")

            AbreLinha(1, "dbf2mysql.txt")

         @ 15, 42 SAY PADL(TsTring(Seconds()-nSecIni), MaxCol()-42) COLOR "W+/N"

         @ 16, 42 SAY PADL(Transform((oElemento1:__enumIndex()/Len(aDBF))*100, "999.99"), MaxCol()-42) COLOR "W+/N"

         &(Alias())->(DbCloseArea())

      NEXT

      @ 11, 42 SAY PADL(Time() ,MaxCol()-42) COLOR "W+/N"

      EscreveLinha("Hora Final  : "+HB_DtoC(Date(),"DD/MM/YYYY")+" "+Time(), cData+"adomysql.log")

      Info("Carga concluida com sucesso.", "Aten‡Æo")
     
      oConnection:Close()

   ELSE
      Pare("NÆo existe DBF para carga nesta pasta.", "Aten‡Æo")
   ENDIF

   oConnection:=NIL

RETURN NIL

FUNCTION MsgStatus(nLinha,nColuna,cMensagem)
   @nLinha,nColuna SAY PADR(cMensagem,MaxCol()+1)
RETURN Nil

INIT FUNCTION AppSetup()

  ANNOUNCE hwg_ErrSys

  //ErrorBlock( { | oError | DefError( oError ) } )

  REQUEST HB_LANG_PT
  REQUEST HB_CODEPAGE_PT850
  HB_LANGSELECT("PT")
  HB_CDPSELECT( "PT850" ) //pt850

  SET TYPEAHEAD TO 0
  SET INTENSITY ON
  SET SCOREBOARD OFF
  SET DELETED ON
  SET SAFETY OFF
  SET DATE BRITI
  SET ESCAPE ON
  SET CENTURY ON
  SET DELIMITERS TO
  SET EXCLUSIVE OFF
  SET WRAP ON
  SET EPOCH TO 1920
  SET OPTIMIZE ON
  SET MESSAGE TO 24 CENTER
  SET AUTOPEN ON
  SET DBFLOCKSCHEME TO DB_DBFLOCK_DEFAULT

  aIndFPT:=Directory("*.FPT")

  IF Len(aIndFPT) > 0
     REQUEST DBFCDX
     RddSetDefault("DBFCDX")
  ELSE
     REQUEST DBFNTX
     RddSetDefault("DBFNTX")
  ENDIF

  SETMODE(26, 80)

  hb_gtReload( "WVT" )

  SetColor("W+/B")

  CLS

  SetColor("W+/B")

  IniciaJanela()

RETURN Nil

FUNCTION IniciaJanela()

PUBLIC cTituloJanela

   cTituloJanela:="AdoMySql - Utilit rio de Migra‡Æo DBF/MySql VersÆo 2016.3"

   HB_gtInfo(HB_GTI_FONTNAME, "Lucida Console")
   HB_gtInfo(HB_GTI_WINTITLE, cTituloJanela)
   HB_gtInfo(HB_GTI_ICONFILE, "P:\GERAL\HARBOUR\HARB_WIN.ICO" )
   HB_gtInfo(HB_GTI_CLOSABLE, .F. )
   HB_gtInfo(HB_GTI_ISGRAPHIC, .T. )
   HB_gtInfo(HB_GTI_STDERRCON, .T. )
   HB_gtInfo(HB_GTI_COMPATBUFFER, .T. )
   HB_gtInfo(HB_GTI_SPEC, HB_GTS_WNDSTATE, HB_GTS_WS_MAXIMIZED )
   HB_gtInfo(HB_GTI_SPEC, HB_GTS_SHOWWINDOW, SW_NORMAL )
   HB_GtInfo( HB_GTI_MAXIMIZED, .T. )

RETURN Nil

FUNCTION HB_GTSYS()
   REQUEST HB_GT_WVT_DEFAULT
   REQUEST HB_GT_WVT
   REQUEST HB_GT_WGU
   REQUEST HB_GT_WVG
RETURN Nil

FUNCTION CriaObjetoConnection(oObjeto)
LOCAL oObjetoConnection:=Win_OleCreateObject( "ADODB.connection" )
   IF oObjeto!=Nil
      oObjeto:=Nil
   ENDIF
   oObjeto:=oObjetoConnection
RETURN oObjetoConnection

FUNCTION CriaObjetoCommand(oObjeto)
LOCAL oObjetoCommand:=Win_OleCreateObject( "ADODB.Command" )
   IF oObjeto!=Nil
      oObjeto:=Nil
   ENDIF
   oObjeto:=oObjetoCommand
RETURN oObjetoCommand

FUNCTION CriaObjetoRecordSet(oObjeto)
LOCAL oObjetoRecordSet:=Win_OleCreateObject( "ADODB.recordset" )
   IF oObjeto!=Nil
      oObjeto:=Nil
   ENDIF
   oObjeto:=oObjetoRecordSet
RETURN oObjetoRecordSet

FUNCTION IniciaCommand
  oCommand:=Nil
  oCommand:=CriaObjetoCommand(@oCommand)
  oCommand:ActiveConnection:=oConnection
  oCommand:CommandType:= adCmdText
RETURN oCommand

FUNCTION RetiraAcentos(cPalavra)
LOCAL i:=0,;
      cAcento:= '',;
      cRetiraAcento:= ''
    FOR I = 1 To Len(cPalavra)
        cAcento:=SUBST(cPalavra, I, 1)
        DO CASE
        CASE cAcento $ "µÇ¶·Ž"
           cAcento = "A"
        CASE cAcento $ "ÓÔÒ"
           cAcento = "E"
        CASE cAcento $ "ÖØÞ×"
           cAcento = "I"
        CASE cAcento $ "àåâ™"
           cAcento = "O"
        CASE cAcento $ "éëêš"
           cAcento = "U"
        CASE cAcento $ " Æƒ…„"
           cAcento = "a"
        CASE cAcento $ "‚‰Šˆ"
           cAcento = "e"
        CASE cAcento $ "¡‹Œ"
           cAcento = "i"
        CASE cAcento = "¢ä“”"
           cAcento = "o"
        CASE cAcento $ "£—–"
           cAcento = "u"
        CASE cAcento $ "‡"
           cAcento = "c"
        CASE cAcento $ "€"
           cAcento = "C"
        CASE cAcento $ "õ"
           cAcento = "§"
        ENDCASE
        cRetiraAcento += cAcento
    NEXT
RETURN cRetiraAcento

FUNCTION MsgNaoSim(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN hwg_MsgNoYes(WIN_OemToAnsi(cMensagem),WIN_OemToAnsi(cTitulo))

FUNCTION Info(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN hwg_MsgInfo(WIN_OemToAnsi(cMensagem),WIN_OemToAnsi(cTitulo))

FUNCTION Pare(cMensagem,cTitulo)
DEFAULT cTitulo TO "Aviso do Sistema"
RETURN hwg_MsgStop(WIN_OemToAnsi(cMensagem),WIN_OemToAnsi(cTitulo))

FUNCTION QualConexao()

LOCAL cNada:="", cServidor, cBanco, cUsuario, cSenha
PRIVATE hWrite:=Hash(), hRead:=HB_ReadIni( "ADOMYSQL.INI" )

   cServidor := Space(20)
   cBanco    := Space(20)
   cUsuario  := Space(20)
   cSenha    := Space(20)
   
   IF hb_FileExists("ADOMYSQL.INI")
       cServidor  :=PADR(hRead["CONFIGURACAO"]["Servidor"], 20)
       cBanco     :=PADR(hRead["CONFIGURACAO"]["Banco"], 20)
       cUsuario   :=PADR(hRead["CONFIGURACAO"]["Usuario"], 20)
       //cSenha     :=PADR(hRead["CONFIGURACAO"]["Senha"], 20)
   ENDIF

   @ 00, 00 SAY PADC(cTituloJanela, MaxCol()+1) COLOR "B/W*"
   
   @ 01, 00 TO 01, MaxCol() COLOR "B+/N"
   
   @ 02, 00 TO 07, MaxCol() COLOR "B+/N"
   
   ClearWin(03, 01, 06, MaxCol()-1, "W+/N")
   
   @ 23, 00 TO 23, MaxCol() COLOR "B+/N"
   
   TermoEspecial(0, 0)
     
   DO WHILE .T.
      @03,01     SAY "Servidor: " COLOR "W+/N"
      @03,Col()  GET cServidor    PICTURE "@" VALID !Empty(cServidor)   COLOR "B+/W*,B/GR*,,,B/W*"
   
      @04,01     SAY "Banco   : " COLOR "W+/N"
      @04,Col()  GET cBanco       PICTURE "@" VALID !Empty(cBanco) COLOR "B+/W*,B/GR*,,,B/W*"
   
      @05,01     SAY "Usuario : " COLOR "W+/N"
      @05,Col()  GET cUsuario     PICTURE "@" VALID !Empty(cUsuario)    COLOR "B+/W*,B/GR*,,,B/W*"
                                                   
      @06,01     SAY "Senha   : " COLOR "W+/N"
      @06,Col()  GET cSenha       PICTURE "@" VALID !Empty(cSenha)    COLOR "B+/W*,B/GR*,,,B/W*"
                                                      ATAIL(GETLIST):READER := {|BL1|GETSEN(BL1)}
      READ
   
      IF LastKey() = 27
         QUIT
      ENDIF
   
      cConexao := "DRIVER={MySQL ODBC 3.51 Driver};"
      cConexao += "server=" + AllTrim(cServidor)
      cConexao += ";database=" + AllTrim(cBanco)
      cConexao += ";uid=" + AllTrim(cUsuario)
      cConexao += ";pwd=" + AllTrim(cSenha)
      TRY
         oConnection:=Nil
         CriaObjetoConnection(@oConnection)
         oConnection:Open(cConexao)
         @05, 52 SAY PADL("Conectado ao MySQL... ", MaxCol()-52) COLOR "G+/N"
      CATCH oErr
         @05, 52 SAY PADL("                       ", MaxCol()-52) COLOR "G+/N"
         TONE(800, 4)
         TONE(800, 4)
         Info(oErr:Operation + " ERRO DE CONEXÇO AO BANCO")
         cSenha:=Space(20)
         LOOP
      END
      hWrite["CONFIGURACAO" ]                   := Hash()
      hWrite["CONFIGURACAO" ]["Servidor"]       := cServidor
      hWrite["CONFIGURACAO" ]["Banco"]          := cBanco
      hWrite["CONFIGURACAO" ]["Usuario"]        := cUsuario
      hWrite["CONFIGURACAO" ]["Senha"]          := cSenha
      HB_WriteIni( "ADOMYSQL.INI", hWrite, "AdoMySql - 2016-03 ", "" )
   
      EXIT
   ENDDO

RETURN Nil

PROCEDURE GETSEN(P1)

   LOCAL L2, L3, L4

   IF GETPREVALIDATE(P1)

      P1:SETFOCUS()
      P1:CARGO := ""

      DO WHILE P1:EXITSTATE() == 0

         IF P1:TYPEOUT()

            P1:EXITSTATE := 5

         ENDIF

         DO WHILE P1:EXITSTATE() == 0

            L2 := INKEY(0)

            IF L2 >= 32 .AND. L2 <= 255

               P1:CARGO := P1:CARGO() + CHR(L2)
               GETAPPLYKEY(P1, 254)

            ELSEIF L2 = 8

               P1:CARGO := SUBSTR(P1:CARGO(), 1, LEN(P1:CARGO()) - 1)
               GETAPPLYKEY(P1, L2)

            ELSEIF L2 = 13  // Sai com tecla ENTER e retorna a
                    // senha digitada
               GETAPPLYKEY(P1, L2)

            ELSEIF L2 = 27  // Sai com Tecla ESC e retorna vazio

               GETAPPLYKEY(P1, L2)

            ENDIF

         ENDDO

         IF  .NOT. GETPOSTVALIDATE(P1)

            P1:EXITSTATE := 0

         ENDIF

      ENDDO

      P1:KILLFOCUS()

   ENDIF

   IF P1:EXITSTATE() <> 7

      P1:VARPUT(P1:CARGO())

   ENDIF

RETURN

FUNCTION TermoEspecial
PARAMETERS C, D
LOCAL cPrint := SET( _SET_DEVICE, 'SCREEN' )
   IF TYPE('_TERMOFIM') = 'U'
       PUBLIC _TERMOFIM
      _TermoFim:=0
   ENDIF
   IF D <> NIL
      @MaxRow(), 00 CLEAR TO MaxRow(), MaxCol()
      @MaxRow(), 00 SAY PADR('0                25                50                75              100' ,MaxCol()+1) COLOR "B/W*"
      _TermoFim:=d
      SET( _SET_DEVICE, cPrint )
      RETURN .T.
   ELSE
      D:=0
      PintaEspecial(MaxRow(), 00, MaxRow(), MaxCol()+1, 47, C, _TermoFim)
   ENDIF
   SET( _SET_DEVICE, cPrint )
RETURN Nil

FUNCTION PintaEspecial

PARAMETERS nLinIni, nColIni, nLinFim, nColFim, nChr, nRegistro, nTotalReg

LOCAL nPorcenta, nTamanho, cTecoTela, nPintar

DEFAULT nLinIni   TO 0,;
        nColIni   TO 0,;
        nLinFim   TO 0,;
        nChr      TO 0,;
        nRegistro TO 0
   nPorcenta := (nRegistro / nTotalReg) * 100
   nTamanho  := 72
   cTecoTela := ""
   nPintar   := Int(((nTamanho * nPorcenta) / 100) * 2)
   @ nLinIni, MaxCol()-4 SAY Transform(nPorcenta, "999%") COLOR "R+/W*"
   cTecoTela := SaveScreen(nLinIni, nColIni, nLinFim, nColFim)
   cTecoTela := Transform(Left(cTecotela,nPintar),;
                             Replicate("X"+Chr(nChr), nPintar))+;
                             SubStr(cTecoTela, nPintar+1)
   RestScreen(nLinIni, nColIni, nLinFim, nColFim, cTecoTela)
RETURN .T.

*-----------------------------------------------------------------------------*
FUNCTION GetFolder( cTitle, cInitPath ) // JK HMG 1.0 Experimental Build 8
*-----------------------------------------------------------------------------*
RETURN HBG_GetFolder( NIL, cTitle, NIL, NIL, cInitPath )

STATIC FUNCTION AbreLinha(nLinha, cArq)
LOCAL I
DEFAULT nLinha TO 1
   FOR I:=1 TO nLinha
      StrFile(""+HB_EOL(), cArq, .T.)
   NEXT
RETURN Nil

STATIC FUNCTION EscreveLinha(cVar, cArq)
   StrFile(cVar, cArq, .T.)
RETURN Nil

/*
* Observa‡äes da migra‡Æo DBF / ORACLE
* -----------------------------------------------------------------------------------------------
* Campos com o nome DESC devem ser renomeados para DESCR, DESC ‚ uma palavra reservada do ORACLE.
* -----------------------------------------------------------------------------------------------
* Instru‡Æo SQL para evitar o ORA-01653: unable to extend table in tablespace
* -----------------------------------------------------------------------------------------------
select
'alter database datafile '||
file_name||
' '||
' autoextend on;'
from
dba_data_files;

alter database datafile 'C:\ORACLEXE\APP\ORACLE\ORADATA\XE\SYSTEM.DBF'  autoextend on;
alter database datafile 'C:\ORACLEXE\APP\ORACLE\ORADATA\XE\USERS.DBF'  autoextend on;
alter database datafile 'C:\ORACLEXE\APP\ORACLE\ORADATA\XE\SYSAUX.DBF'  autoextend on;
alter database datafile 'C:\ORACLEXE\APP\ORACLE\ORADATA\XE\UNDOTBS1.DBF'  autoextend on;

alter database datafile 'C:\ORACLEXE\APP\ORACLE\ORADATA\XE\SYSTEM.DBF'  autoextend on next 10000M MAXSIZE UNLIMITED;

select tablespace_name, file_name, bytes/1048576 File_Size_MB, autoextensible, increment_by from dba_data_files order by file_id

Criar TABLESPACE:

CREATE tablespace wiliam datafile 'C:\oraclexe\app\oracle\oradata\XE\asaprev.dbf'
size 100m
autoextend on
next 50m
maxsize 20g;

Aceitar caracteres acentuados da lingua portuguesa.

ALTER SESSION SET NLS_LANGUAGE = "PORTUGUESE";
ALTER SESSION SET NLS_TERRITORY = "BRAZIL";

OU

conn sys as sysdba;
SHUT;
STARTUP RESTRICT;
Alter database character set INTERNAL_USE WE8ISO8859P1;
SHUT;
STARTUP;

*/

#pragma BEGINDUMP
#define _WIN32_IE 0x0500

#ifdef __POCC__
#define _WIN32_WINNT 0x0500
#else
#define _WIN32_WINNT 0x0400
#endif

#include <windows.h>

#include "hbapi.h"

#include <commdlg.h>
#include <shlobj.h>
#include <commctrl.h>
#include <setupapi.h>

#include "hbapiitm.h"

#define HB_PARSTRDEF( n, h, len )             hwg_wstrnull( hwg_wstrget( hb_param( n, HB_IT_ANY ), h, len ) )
#define HB_RETSTR( str )                      hwg_wstrset( hb_param( -1, HB_IT_ANY ), str )

#ifdef __XHARBOUR__
#define HB_PARNL( n, x ) hb_parnl( n, x )
#define HB_STORC( n, x, y ) hb_storc( n, x, y )
#define HB_STORL( n, x, y ) hb_storl( n, x, y )
#define HB_STORNI( n, x, y ) hb_storni( n, x, y )
#define HB_STORNL( n, x, y ) hb_stornl( n, x, y )
#else
#define HB_PARNL( n, x ) hb_parvnl( n, x )
#define HB_STORC( n, x, y ) hb_storvc( n, x, y )
#define HB_STORL( n, x, y ) hb_storvl( n, x, y )
#define HB_STORNI( n, x, y ) hb_storvni( n, x, y )
#define HB_STORNL( n, x, y ) hb_storvnl( n, x, y )
#endif

#ifdef __XHARBOUR__
#define HB_ISNIL( n )       ISNIL( n )
#define HB_ISCHAR( n )      ISCHAR( n )
#define HB_ISNUM( n )       ISNUM( n )
#define HB_ISLOG( n )       ISLOG( n )
#define HB_ISDATE( n )      ISDATE( n )
#define HB_ISBYREF( n )     ISBYREF( n )
#define HB_ISARRAY( n )     ISARRAY( n )
#endif

HB_FUNC( CHOOSEFONT )
{
   CHOOSEFONT cf;
   LOGFONT lf;
   long PointSize;
   int bold;
   HDC hdc;
   HWND hwnd;

   strcpy( lf.lfFaceName, hb_parc(1) );

   hwnd = GetActiveWindow();
   hdc = GetDC( hwnd );

   lf.lfHeight = -MulDiv( hb_parnl(2), GetDeviceCaps(hdc, LOGPIXELSY), 72 );

   if( hb_parl(3) )
      lf.lfWeight = 700;
   else
      lf.lfWeight = 400;

   if( hb_parl(4) )
      lf.lfItalic = TRUE;
   else
      lf.lfItalic = FALSE;

   if( hb_parl(6) )
      lf.lfUnderline = TRUE;
   else
      lf.lfUnderline = FALSE;

   if( hb_parl(7) )
      lf.lfStrikeOut = TRUE;
   else
      lf.lfStrikeOut = FALSE;

   lf.lfCharSet = ( BYTE ) hb_parni( 8 );

   cf.lStructSize = sizeof( CHOOSEFONT );
   cf.hwndOwner = hwnd;
   cf.hDC = ( HDC ) NULL;
   cf.lpLogFont = &lf;
   cf.Flags = HB_ISNUM( 9 ) ? hb_parni( 9 ) : CF_SCREENFONTS | CF_EFFECTS | CF_INITTOLOGFONTSTRUCT;
   cf.rgbColors = hb_parnl( 5 );
   cf.lCustData = 0L;
   cf.lpfnHook = ( LPCFHOOKPROC ) NULL;
   cf.lpTemplateName = ( LPSTR ) NULL;
   cf.hInstance = ( HINSTANCE ) NULL;
   cf.lpszStyle = ( LPSTR ) NULL;
   cf.nFontType = SCREEN_FONTTYPE;
   cf.nSizeMin = 0;
   cf.nSizeMax = 0;

   if( !ChooseFont(&cf) )
   {
      hb_reta( 8 );
      HB_STORC( "", -1, 1 );
      HB_STORNL( ( LONG ) 0, -1, 2 );
      HB_STORL( 0, -1, 3 );
      HB_STORL( 0, -1, 4 );
      HB_STORNL( 0, -1, 5 );
      HB_STORL( 0, -1, 6 );
      HB_STORL( 0, -1, 7 );
      HB_STORNI( 0, -1, 8 );
      ReleaseDC( hwnd, hdc );
      return;
   }

   PointSize = -MulDiv( lf.lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY) );

   if( lf.lfWeight == 700 )
      bold = 1;
   else
      bold = 0;

   hb_reta( 8 );
   HB_STORC( lf.lfFaceName, -1, 1 );
   HB_STORNL( ( LONG ) PointSize, -1, 2 );
   HB_STORL( bold, -1, 3 );
   HB_STORL( lf.lfItalic, -1, 4 );
   HB_STORNL( cf.rgbColors, -1, 5 );
   HB_STORL( lf.lfUnderline, -1, 6 );
   HB_STORL( lf.lfStrikeOut, -1, 7 );
   HB_STORNI( lf.lfCharSet, -1, 8 );

   ReleaseDC( hwnd, hdc );
}

HB_FUNC( C_GETFILE )
{
   OPENFILENAME ofn;
   char buffer[ 32768 ];
   char cFullName[ 256 ][ 1024 ];
   char cCurDir[ 512 ];
   char cFileName[ 512 ];
   int iPosition = 0;
   int iNumSelected = 0;
   int n;

   DWORD flags = OFN_FILEMUSTEXIST;

   buffer[ 0 ] = 0;

   if( hb_parl(4) )
      flags = flags | OFN_ALLOWMULTISELECT | OFN_EXPLORER;

   if( hb_parl(5) )
      flags = flags | OFN_NOCHANGEDIR;

   memset( ( void * ) &ofn, 0, sizeof( OPENFILENAME ) );
   ofn.lStructSize = sizeof( ofn );
   ofn.hwndOwner = GetActiveWindow();
   ofn.lpstrFilter = hb_parc( 1 );
   ofn.nFilterIndex = 1;
   ofn.lpstrFile = buffer;
   ofn.nMaxFile = sizeof( buffer );
   ofn.lpstrInitialDir = hb_parc( 3 );
   ofn.lpstrTitle = hb_parc( 2 );
   ofn.nMaxFileTitle = 512;
   ofn.Flags = flags;

   if( GetOpenFileName(&ofn) )
   {
      if( ofn.nFileExtension != 0 )
         hb_retc( ofn.lpstrFile );
      else
      {
         wsprintf( cCurDir, "%s", &buffer[ iPosition ] );
         iPosition = iPosition + strlen( cCurDir ) + 1;

         do
         {
            iNumSelected++;
            wsprintf( cFileName, "%s", &buffer[ iPosition ] );
            iPosition = iPosition + strlen( cFileName ) + 1;
            wsprintf( cFullName[ iNumSelected ], "%s\\%s", cCurDir, cFileName );
         }
         while( ( strlen(cFileName) != 0 ) && ( iNumSelected <= 255 ) );

         if( iNumSelected > 1 )
         {
            hb_reta( iNumSelected - 1 );

            for( n = 1; n < iNumSelected; n++ )
               HB_STORC( cFullName[ n ], -1, n );
         }
         else
            hb_retc( &buffer[ 0 ] );
      }
   }
   else
      hb_retc( "" );
}

// JK JP

// JK HMG 1.0 Experimental Build 8
// --- callback function for C_BROWSEFORFOLDER(). Contributed By Andy Wos

HB_FUNC( SELECTFOLDER2 )
{
   BROWSEINFO bi;
   TCHAR lpBuffer[ MAX_PATH ];
   LPCTSTR lpResult = NULL;
   LPITEMIDLIST pidlBrowse;     // PIDL selected by user
   void * hTitle;

   SHGetSpecialFolderLocation( GetActiveWindow(), HB_ISNIL(2) ? CSIDL_DRIVES : hb_parni(2), &pidlBrowse );

   bi.hwndOwner = GetActiveWindow();
   bi.pidlRoot = pidlBrowse;
   bi.pszDisplayName = lpBuffer;
   bi.lpszTitle = HB_PARSTRDEF( 1, &hTitle, NULL );
   bi.ulFlags = BIF_USENEWUI;
   bi.lpfn = NULL;
   bi.lParam = 0;
   bi.iImage = 0;

   // Browse for a folder and return its PIDL.

   pidlBrowse = SHBrowseForFolder( &bi );

   if( pidlBrowse )
   {
      SHGetPathFromIDList( pidlBrowse, lpBuffer );
      hb_retc( lpBuffer );
   }
   else
      hb_retc( "" );

   /*pidlBrowse = SHBrowseForFolder( &bi );
   if( pidlBrowse != NULL )
   {
      if( SHGetPathFromIDList( pidlBrowse, lpBuffer ) )
         lpResult = lpBuffer;
      CoTaskMemFree( pidlBrowse );
   }
   HB_RETSTR( lpResult ); */
   hb_strfree( hTitle );
}

HB_FUNC( CHOOSECOLOR )
{
   CHOOSECOLOR cc;
   COLORREF crCustClr[ 16 ];
   int i;

   for( i = 0; i < 16; i++ )
      crCustClr[ i ] = ( HB_ISARRAY(3) ? ( COLORREF ) HB_PARNL(3, i + 1) : GetSysColor(COLOR_BTNFACE) );

   cc.lStructSize = sizeof( CHOOSECOLOR );
   cc.hwndOwner = HB_ISNIL( 1 ) ? GetActiveWindow() : ( HWND ) hb_parnl( 1 );
   cc.rgbResult = ( COLORREF ) HB_ISNIL( 2 ) ? 0 : hb_parnl( 2 );
   cc.lpCustColors = crCustClr;
   cc.Flags = ( WORD ) ( HB_ISNIL(4) ? CC_ANYCOLOR | CC_FULLOPEN | CC_RGBINIT : hb_parnl(4) );

   if( !ChooseColorA(&cc) )
      hb_retnl( -1 );
   else
      hb_retnl( cc.rgbResult );
}
#pragma ENDDUMP
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor asimoes » 20 Mar 2016 18:55

Continuando com o post anterior:

No Dbf o campo DATAPRO, depois de 109/00000008-2

Screen Shot 03-20-16 at 06.47 PM.PNG
DBF
Screen Shot 03-20-16 at 06.47 PM.PNG (4.35 KiB) Visualizado 25124 vezes


No HeidiSql, a data que está nula no dbf: 0000-00-07

Screen Shot 03-20-16 at 06.48 PM.PNG
HeidiSql
Screen Shot 03-20-16 at 06.48 PM.PNG (6.43 KiB) Visualizado 25124 vezes


Mas teve registro que não gravou na tabela.
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor asimoes » 20 Mar 2016 22:17

Pessoal,

Utilizando estes comandos o driver odbc do MySql falha, então fiz de outra forma.

Assim não funciona com campos tipo data (até esse momento) com data nulas, neste caso atribuindo Nil a cTheValue
cQuery += "?"+IF(!lLast, ", ", "")
Param1 := oCommand:CreateParameter(cNomeCampo, adDate, adParamInput, oElemento2[3], cTheValue)
oCommand:Parameters:Append( Param1)
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor asimoes » 20 Mar 2016 22:56

Mesmo atribuindo:

cTheValue:='0000-00-00'

Dá erro no CreateParameter, qualquer data diferente disso, passa.

cQuery += "?"+IF(!lLast, ", ", "")
Param1 := oCommand:CreateParameter(cNomeCampo, adDate, adParamInput, oElemento2[3], cTheValue) //Erro com '0000-00-00'
oCommand:Parameters:Append( Param1)
.
.
oCommand:CommandText:= cQuery
oCommand:Execute()

Screen Shot 03-20-16 at 10.47 PM.PNG


O interessante que assim funciona, sem CreateParameter: pode ser que os coringas "?" não funcionem bem com data '0000-00-00', enfim não sei.

CASE oElemento2[2] = "D"
   IF cTheValue=Nil
      cQuery += '0000-00-00'+IF(!lLast, ", ", "")
   ELSE
      cQuery +="'"+Transform( Dtos( cTheValue ), "@R 9999-99-99" )+"'"+IF(!lLast, ", ", "") 
   ENDIF

.
.

oConnection:Execute( cQuery )
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor asimoes » 21 Mar 2016 00:02

O que eu estou tentando fazer é algo similar a este código:
O problema está com somente com datas nulas.
conn.Open
   Set adoCommand = New ADODB.Command
      With adoCommand
         Set .ActiveConnection = conn
         .CommandType = adCmdText
         .CommandText = "INSERT INTO tblClass (clStudent, clClass, clPaid) VALUES (?,?,?)"
         .Prepared = True
         For Each Dt In dPaidDates
            .Parameters.Append .CreateParameter(, adDouble, adParamInput, , lStudentID)
            .Parameters.Append .CreateParameter(, adDate, adParamInput, , Dt)
            .Parameters.Append .CreateParameter(, adBoolean, adParamInput, , 0)
            .Execute , , adCmdText + adExecuteNoRecords
         Next Dt
     End With
     Set adoCommand = Nothing
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Tutorial de ADO

Mensagempor asimoes » 21 Mar 2016 08:05

Olá Pessoal,

Bom dia,

Deve ter mesmo algum problema com o driver ODBC ou usando adodb.command provoca o erro:

Imagem no DBF:
Screen Shot 03-21-16 at 08.01 AM 001.PNG
Screen Shot 03-21-16 at 08.01 AM 001.PNG (8 KiB) Visualizado 25109 vezes


Imagem no heidisql:
Screen Shot 03-21-16 at 08.01 AM.PNG
Screen Shot 03-21-16 at 08.01 AM.PNG (9.29 KiB) Visualizado 25109 vezes
►Harbour 3.x | Minigui xx-x | HwGui◄
Pense nas possibilidades abstraia as dificuldades.
Não corrigir nossas falhas é o mesmo que cometer novos erros.
A imaginação é mais importante que o conhecimento. (Albert Einstein)
Avatar de usuário

asimoes
Colaborador

Colaborador
 
Mensagens: 4919
Data de registro: 26 Abr 2007 16:48
Cidade/Estado: RIO DE JANEIRO-RJ
Curtiu: 341 vezes
Mens.Curtidas: 258 vezes

Anterior Próximo



Retornar para Contribuições, Dicas e Tutoriais

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 21 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