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