Recentemente tive que converter um sistema clipper + dbf para Harbour + Minigui, até aqui tudo bem, o grande problema seria converter os vários dbf's para SQL,
sabendo que renomeando um arquivo.dbf para arquivo.xls dá para abrir no excel, veio a oportunidade de melhorar o que já estava pronto.
na pasta C:\MiniGUI\SAMPLES\Advanced\ReadXLS tem um programa para ler arquivos "xls"...
Alterei algumas coisinhas para poder alterar nome,tipo,tamanho e decimal das colunas, excluir linhas no grid e remover acentos para gerar script de criação
e insert das tabelas.
Faltas apuradas:
1) Informar nome e local do arquivo a ser gerado ,
2) Comparar conteudo(lenght) do campo com tamanho definido na estrutura,
3) Comparar conteudo do campo com tipo definido na estrutura
EX:( campo definido como numeric/number na estrutura
conteudo do campo: alfanumerico )
4) Opção para remover coluna(s) no grid (Mas isso pode ser feito no excel mesmo)
segue o fonte modificado.
Código: Selecionar todos
// Programa alterado em 27/09/2014
// Luiz antonio da silva
#include "MiniGUI.ch"
#define NTrim( n ) LTRIM( STR( n, IF( n == INT( n ), 0, 2 ) ) )
Static aNamis := {}
Static aFila := {}
Static aWitis := {}
Static aHojita := {}
Static nWcrt := 0
Static nHcrt := 0
STATIC TIPOS:={'VARCHAR','VARCHAR2','CHAR','NUMERIC','NUMBER','DATE'}
static acentos:={'à','è','ì','ò','À','È','Ì','Ò','á','Á','â','Â','ã','Â','é','É','ê','Ê','í','Í','ó','Ó','ô','Ô','ú','Ú','ç','Ç'}
static normal :={'a','e','i','o','A','E','I','O','a','A','a','A','a','A','e','E','e','E','i','I','o','O','o','O','u','U','c','C'}
STATIC TACENTO:=.T.
Function Main()
PUBLIC IX:=XL:=0
PUBLIC NOME_COL:={}, xfile
nWcrt := GetDesktopWidth()
nHcrt := GetDesktopHeight()-28
DEFINE WINDOW winmain ;
AT 0,0 WIDTH nWcrt HEIGHT nHcrt ;
TITLE 'LER ARQUIVO XLS' ;
MAIN
@050,001 GRID Grid_1 WIDTH nWcrt-03 HEIGHT nHcrt-100 ;
FONT "Ms Sans Serif" SIZE 09 ;
HEADERS { "" } ;
WIDTHS { 100 } ;
ITEMS { { "" } };
VALUE 1;
on dblclick tira_linha()
DEFINE BUTTON cmdxls
ROW 015
COL 005
WIDTH 98
HEIGHT 24
CAPTION "&Abrir XLS"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
ACTION FAR_OpenXLS()
FLAT .T.
END BUTTON
DEFINE BUTTON gscript
ROW 015
COL 115
WIDTH 98
HEIGHT 24
CAPTION "&SCRIPT"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
ACTION GRAVA()
FLAT .T.
END BUTTON
DEFINE CHECKBOX tacento
ROW 017
COL 225
WIDTH 100
HEIGHT 24
CAPTION "&Tirar acentos"
FONTNAME "Ms Sans Serif"
FONTSIZE 9
END checkbox
DEFINE LABEL LB1
ROW 018
COL 340
WIDTH 500
HEIGHT 30
VALUE ""
FONTNAME "Ms Sans Serif"
FONTSIZE 14
END label
END WINDOW
winmain.Maximize()
ACTIVATE WINDOW winmain
Return Nil
Static Function FAR_OpenXLS()
LOCAL ccFile
if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
ccFile := getfile({{"Archivos excel (*.xls*)","*.xls*"}},"Selecione um archivo excel",GetCurrentFolder(),.f.)
endif
if EMPTY(ccFile) .or. ccFile==NIL .or. LEN(ccFile)=0 .or. !file(ccFile)
return nil
endif
xfile:=ccFile
WINMAIN.LB1.VALUE:="Aguarde...Carregando arquivo "+xfile
WINMAIN.LB1.REFRESH
Load_XLS_CLI( ccFile )
WINMAIN.LB1.VALUE:="ARQUIVO CARREGADO..."+ALLTRIM(STR(INT(IX)))+" Colunas, "+ALLTRIM(STR(INT(XL)))+" Linhas"
WINMAIN.LB1.REFRESH
Return Nil
Static Function Load_XLS_CLI( cArchivo )
LOCAL nFilas := 0
LOCAL nColumns := 0
LOCAL nnColumn := 0
LOCAL nuColumn
LOCAL ccValue
LOCAL i := 0
LOCAL j := 0
LOCAL oExcel as Object
LOCAL oWorkBook
LOCAL oHoja
LOCAL ccNameIs := ""
LOCAL NoSale := TRUE
LOCAL nnWiti := 0
LOCAL aTypes AS ARRAY
oExcel := TOleAuto():New( "Excel.Application" )
IF oExcel == nil
MsgStop('Excel não está instalado!','Error')
RETURN Nil
Endif
oWorkBook := oExcel:WorkBooks:Open( cArchivo )
oExcel:Sheets(1):Select()
oHoja := oExcel:ActiveSheet()
oExcel:Visible := .F. // <---- No Mostrar
oExcel:DisplayAlerts := .t. // <---- esta elimina mensajes
//
************** LOOP LECTURA PLANILLA EXCEL ******************
//
//------------ Averiguo Cantida de Filas ------------------
//
nFilas := oHoja:UsedRange:Rows:Count()
//
//------------ Averiguo Cantida de Columnas ------------------
//
nnColumn := 0
//
aNamis := {}
//
i := 0
nuColumn := 0
nColumns := Len( getProperty( "winmain", "Grid_1", "Item", 1 ) )
DO WHILE nColumns != 0
winmain.Grid_1.DeleteColumn( nColumns )
nColumns--
ENDDO
Do While NoSale
i := i + 1
ccValue := AnyToString( oHoja:cells(2,i):value )
nnWiti := GetLenColumn( LEN( ccValue ) )
ccNameIs := AnyToString( oHoja:cells(01, i):value )
IF EMPTY( ccNameIs ) .or. LEN( ccNameIs ) = 0 .or. ccNameIs = ' '
nuColumn := i - 1
NoSale := FALSE
ELSE
winmain.Grid_1.AddColumn( i, ccNameIs, nnWiti, 0 )
Do Events
AADD(aNamis, ccNameIs )
AADD(aWitis, 120)
AADD(NOME_COL, ccNameIs)
nnColumn := i
ENDIF
EndDo
//
IF nuColumn <> nnColumn
MsgInfo("nuColumn " + str(nuColumn) + " nnColumn " + str(nnColumn))
ELSE
IX:=NNCOLUMN
ENDIF
//
//------------------------------------------------------------
//
aFila := {}
aTypes := {}
//
FOR i=2 TO nFilas Step 1
FOR j=1 TO nnColumn Step 1
ccValue := AnyToString( oHoja:cells(i,j):value )
AADD(aFila, ccValue )
AADD(aTypes, "C")
NEXT j
winmain.Grid_1.addItem( ItemChar(aFila, aTypes) )
XL+=1
AADD(aHojita, aFila )
aFila := {}
aTypes := {}
Do Events
Next i
oExcel:DisplayAlerts := .F. // <---- esta elimina mensajes
oWorkBook:Close()
oExcel:Quit()
oWorkBook := NIL
oHoja := NIL
oExcel := NIL
winmain.title := cArchivo
Release oWorkBook
Release oHoja
Release oExcel
RETURN Nil
*----------------------------------------------------------------------*
FUNCTION ItemChar(aLine, aType)
*----------------------------------------------------------------------*
LOCAL aRet:={}, x:=0, l:=0
aRet:=array( len(aLine) )
l:=len(aRet)
FOR x:=1 TO l
do case
case aType[x]=="N"
aRet[x]:=NTrim(aLine[x])
case aType[x]=="D"
aRet[x]:=dtoc(aLine[x])
case aType[x]=="L"
aRet[x]:=iif(aLine[x], "TRUE", "FALSE")
otherwise
aRet[x]:=aLine[x]
endcase
NEXT
RETURN aRet
*----------------------------------------------------------------------*
FUNCTION AnyToString(csValue)
*----------------------------------------------------------------------*
LOCAL ccValor := ""
LOCAL cdate
LOCAL cFormatoDaData := set(4)
SET DECIMALS TO 0
DO CASE
CASE Valtype(csValue) == "N"
ccValor := AllTrim(Str(csValue))
CASE Valtype(csValue) == "D"
IF !Empty(csValue)
cdate := dtos(csValue)
ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
ELSE
ccValor := ""
ENDIF
CASE Valtype(csValue) == "T"
IF !Empty(csValue)
cdate := dtos(csValue)
ccValor := substr(cDate,1,4) + "-" + substr(cDate,5,2) + "-" + substr(cDate,7,2)
ELSE
ccValor := ""
ENDIF
CASE Valtype(csValue) $ "CM"
IF Empty( csValue)
ccValor=""
ELSE
ccValor := "" + csValue+ ""
ENDIF
CASE Valtype(csValue) == "L"
ccValor := AllTrim(Str(iif(csValue == .F., 0, 1)))
OTHERWISE
ccValor := "" // NOTE: Here we lose csValues we cannot convert
ENDCASE
RETURN( ccValor )
*----------------------------------------------------------------------*
FUNCTION GetLenColumn( nnLen )
*----------------------------------------------------------------------*
LOCAL nnValor := 120
IF nnLen < 6
nnValor := 70
ELSEIF nnLen < 10
nnValor := 110
ELSEIF nnLen < 20
nnValor := 140
ELSEIF nnLen < 40
nnValor := 240
ELSE
nnValor := 380
ENDIF
RETURN( nnValor )
*----------------------------------------------------------------------*
FUNC GRAVA()
*----------------------------------------------------------------------*
opc:=msgyesno("Criar Script para Tabela SQL ?","Final")
if opc=.t.
define window cfg at 0,0 width 450 height 400 title "FD" on init carrega_nomes() TOPMOST
@ 10,10 GRID Grid_tab ;
WIDTH 380;
HEIGHT 250;
HEADERS { "Campo","Tipo","Size","Dec" };
WIDTHS { 100,120,60,60 };
ITEMS {};
EDIT ;
COLUMNCONTROLS { {'TEXTBOX','CHARACTER',20} , {'COMBOBOX',{'VARCHAR','VARCHAR2','CHAR','NUMERIC','NUMBER','DATE'}} , { 'SPINNER' , 0 , 100 } , { 'SPINNER' , 0 , 100 }}
define button bt1
row 260
col 10
width 100
height 30
caption "criar"
action cria_tb()
end button
define LABEL LB1
row 300
col 120
width 200
height 30
VALUE ""
end LABEL
end window
center window cfg
activate window cfg
endif
QUIT
RETU
*----------------------------------------------------------------------*
func carrega_nomes()
*----------------------------------------------------------------------*
for l=1 to len(nome_col)
add item { NOME_COL[L],1,101,0 } to grid_tab of cfg
next l
retu
*----------------------------------------------------------------------*
func cria_tb()
*----------------------------------------------------------------------*
cfg.lb1.value:="Aguarde Criando Script !"
cfg.bt1.enabled:=.f.
// cria estrutura da tabela
nm_tb1:=strtran(xfile,".xls","")
ii:=len(alltrim(nm_tb1))+1
ps:=0
while ii>0
ii-=1
vr:=subst(nm_tb1,ii,1)
if vr="\" .or. vr="/"; ps:=ii; exit; endif
enddo
tm:=len(alltrim(nm_tb1))
tmt:=tm-((tm-ps)+1)
nm_tab:=subst(nm_tb1,ps+1,tmt)
if len(alltrim(nm_tab))=0
msginfo("Erro no nome da tabela !"+crlf+"Nome temporario: Table_1","erro")
nm_tab:="Table_1"
endif
nm_arq:=nm_tb1+".sql"
arq:=fcreate(nm_arq)
fwrite(arq, "create table "+nm_tab+chr(10))
fwrite(arq, "("+chr(10))
for c=1 to cfg.grid_tab.itemcount
linha:=""
if cfg.grid_tab.cell(c,4)<>0
if c<cfg.grid_tab.itemcount
linha:=" "+alltrim(cfg.grid_tab.cell(c,1))
LINHA+=" " +TIPOS[cfg.grid_tab.cell(c,2)]
LINHA+="(" +alltrim(STR(INT(cfg.grid_tab.cell(c,3))))
LINHA+="," +alltrim(STR(INT(cfg.grid_tab.cell(c,4))))
LINHA+="),"
else
linha:=" "+alltrim(cfg.grid_tab.cell(c,1))
LINHA+=" " +TIPOS[cfg.grid_tab.cell(c,2)]
LINHA+="(" +alltrim(STR(INT(cfg.grid_tab.cell(c,3))))
LINHA+="," +alltrim(STR(INT(cfg.grid_tab.cell(c,4))))
LINHA+=+")"
endif
else
if c<cfg.grid_tab.itemcount
linha:=" "+alltrim(cfg.grid_tab.cell(c,1))
LINHA+=" " +TIPOS[cfg.grid_tab.cell(c,2)]
LINHA+="(" +alltrim(STR(INT(cfg.grid_tab.cell(c,3))))
LINHA+="),"
else
linha:=" "+alltrim(cfg.grid_tab.cell(c,1))
LINHA+=" " +TIPOS[cfg.grid_tab.cell(c,2)]
LINHA+="(" +alltrim(STR(INT(cfg.grid_tab.cell(c,3))))
LINHA+=")"
endif
endif
fwrite(arq, linha+chr(10))
next c
fwrite(arq, ")"+chr(10))
fwrite(arq, " "+chr(10))
// cria insert da tabela
for l=1 to winmain.grid_1.itemcount
linha:="insert into "+nm_tab+" values("
for c=1 to cfg.grid_tab.itemcount
if TIPOS[cfg.grid_tab.cell(c,2)]='VARCHAR' .or. TIPOS[cfg.grid_tab.cell(c,2)]='VARCHAR2' .or. TIPOS[cfg.grid_tab.cell(c,2)]='CHAR'
oCAMPO:=alltrim(winmain.grid_1.cell(l,c))
IF AT("'",alltrim(winmain.grid_1.cell(l,c)))<>0
oCAMPO:=ALLTRIM(STRTRAN(winmain.grid_1.cell(l,c),"'",""))
ENDIF
IF winmain.tacento.value=.t.
for ac=1 to len(acentos)
if at(acentos[ac],oCAMPO)<>0
oCAMPO:=STRTRAN(oCAMPO,acentos[ac],normal[ac])
endif
next ac
endif
if len(oCAMPO)=0
ct:="''"
else
ct:="'"+oCAMPO+"'"
endif
if c<cfg.grid_tab.itemcount
linha+=ct+","
else
linha+=ct+")"
endif
endif
if TIPOS[cfg.grid_tab.cell(c,2)]='NUMERIC' .or. TIPOS[cfg.grid_tab.cell(c,2)]='NUMBER'
if len(alltrim(winmain.grid_1.cell(l,c)))=0
ct:="0"
else
ct:=alltrim(winmain.grid_1.cell(l,c))
endif
if c<cfg.grid_tab.itemcount
linha+=ct+","
else
linha+=ct+")"
endif
endif
if TIPOS[cfg.grid_tab.cell(c,2)]='DATE'
if len(alltrim(winmain.grid_1.cell(l,c)))=0
ct:="''"
else
_RECEBE:=ALLTRIM(winmain.grid_1.cell(l,c))
_DIA :=SUBST(_RECEBE,1,2)
_MES :=SUBST(_RECEBE,4,2)
_ANO :=SUBST(_RECEBE,7,4)
ct :="'"+_ANO+"-"+_MES+"-"+_DIA+"'"
if c<cfg.grid_tab.itemcount
linha+=ct+","
else
linha+=ct+")"
endif
endif
endif
next c
fwrite(arq, LINHA+CHR(10))
next l
cfg.lb1.value:="Script Completo !"
msginfo("Script SQL criado !","FIM")
fclose(arq)
cfg.release
retu
*----------------------------------------------------------------------*
func tira_linha()
*----------------------------------------------------------------------*
ps:=winmain.Grid_1.value
winmain.Grid_1.deleteitem(ps)
retu
