PC Toledo

Código: Selecionar todos

******************************************************
func CsvToDbf(vvvCSV,vvvCabec,vvvSeparador,vvvTamMax)
******************************************************
*Converte .CSV para .DBF. com opcao de criar
*campos com mesmo nome dos cabecalhos, ou com
*nomes de campos apenas numerados.
*ONDE:   vvvCSV        Nome do ARQUIVO.CSV ou Outro Tipo .TXT 
*        vvvCabec      .t. Ler 1a linha  (Padrao)  
*                      .f. Nao ler 1a Linha 
*        vvvSeparador  Sinal Separador, padrao (;)
*        vvvTamMax     Tamanho maximo dos campos padrao (20) 
*
*Utiliza AREA PROVISORIA 7 (Select 7).
*Retorna .t. ou .f. se conversao for sucesso ou erro.
**************************************************************
//Guardando Area corrente
vvvarea0=alltrim(str(select(dbf())))

vvvCSV=upper(vvvCSV)
if vvvTamMax=nil
   vvvTamMax=20
Endif
if at(".CSV",vvvCSV)=0
   vvvCSV=vvvCSV+".CSV"
endif
vvvDBF=strtran(vvvCSV,".CSV",".DBF")
if file(vvvDBF)
   //Se ja existir DBF com o nome do CSV retorne erro.
   return .f.
endif
If vvvSeparador=Nil
   vvvSeparador=";"
Endif
if vvvCabec=nil
   vvvCabec=.t.
endif

//Criando Estrutura do DBF Destino
vvvhCSV=fopen(vvvCSV)
vvvContaCampo=1
vvvLinha=freadLine(vvvhCSV)
vvvEstrut={}
vvvFinalizar=.f.
do while .t.
   if at(vvvSeparador,vvvLinha)=0
      vvvFinalizar=.t.
   endif
   vvvCampo="CAMPO"+strzero(vvvContaCampo,3)
   aadd(vvvEstrut,{vvvCampo,"C",vvvTamMax,0})
   vvvLinha=right(vvvlinha,len(vvvLinha)-at(vvvSeparador,vvvLinha))
   vvvContaCampo++
   if vvvFinalizar=.t.
      exit
   Endif
Enddo
dbcreate(vvvDBF,vvvEstrut)
fclose(vvvhCSV)

//Preenchendo novo DBF
Select 7
use &vvvDBF

//O Comando abaixo poderia ser utilizado finalizando
//a funcao neste ponto. Porem, encontro problemas na importacao quando
//existe algum caractere estranho dentro do CSV. Como por exemplo Alt+160.
//comando: Append From &vvvCSV DELIMITED WITH ({,vvvSeparador})
     
vvvhCSV=fopen(vvvCSV)
vvvContaCampo=1
vvvLinha=freadLine(vvvhCSV)
vvvFinalLinha=.f.
vvvContaLinha=1
do while .not. feof(vvvhCSV)
   if at(vvvSeparador,vvvLinha)=0
      vvvLinha=vvvLinha+vvvSeparador
      vvvFinalLinha=.t.
   endif
   vvvCampo="CAMPO"+strzero(vvvContaCampo,3)
   vvvConteudo = left(vvvLinha,at(vvvSeparador,vvvLinha)-1)
   vvvLinha=right(vvvlinha,len(vvvLinha)-at(vvvSeparador,vvvLinha))
   if lastrec() < vvvContalinha
      append blank
   Endif
   replace &vvvCampo with vvvConteudo
   vvvContaCampo++
   If vvvFinalLinha=.t.
      vvvLinha=freadLine(vvvhCSV)
      vvvContaCampo=1
      vvvFinalLinha=.f.
      vvvContaLinha++
   endif
Enddo
Close
fclose(vvvhCSV)
Select &vvvArea0

Código: Selecionar todos

REQUEST HB_MEMIO  // <=== esta linha
REQUEST DBFCDX

PROCEDURE Main()
  
   LOCAL ...

Código: Selecionar todos

Em Harbour:
hbmk2 teste hbmemio.hbc

Código: Selecionar todos

REQUEST HB_MEMIO
REQUEST DBFCDX

FUNCTION Teste()

   LOCAL aLayOut := {}

   AAdd( aLayOut, { "MEM_COD"  , "C", 010, 000 } )
   AAdd( aLayOut, { "MEM_COMP",  "N", 011, 002 } )
   AAdd( aLayOut, { "MEM_ADI1",  "N", 006, 002 } )
   AAdd( aLayOut, { "MEM_DT1",   "C", 001, 000 } )
   AAdd( aLayOut, { "MEM_BASE",  "N", 011, 002 } )
   AAdd( aLayOut, { "MEM_MGL",   "N", 010, 003 } )
   AAdd( aLayOut, { "MEM_DT2",   "C", 001, 000 } )
   AAdd( aLayOut, { "MEM_UNI",   "N", 011, 002 } )
   AAdd( aLayOut, { "MEM_ADI2",  "N", 006, 002 } )
   AAdd( aLayOut, { "MEM_DT3",   "C", 001, 000 } )
   AAdd( aLayOut, { "MEM_LIQ",   "N", 011, 002 } )
   AAdd( aLayOut, { "MEM_DES",   "N", 006, 002 } )
   AAdd( aLayOut, { "MEM_DT4",   "C", 001, 000 } )
   AAdd( aLayOut, { "MEM_PROM1", "N", 011, 002 } )
   AAdd( aLayOut, { "MEM_PROM2", "N", 011, 002 } )
   AAdd( aLayOut, { "MEM_SITUA", "C", 030, 000 } )

   RddSetDefault( "DBFCDX" )

   // Cria um DBF...
   // The <lOpenNew> parameter specifies if the already created database is to be opened, and where.
   // If NIL, the file is not opened. If .T. (true), it is opened in a new work area, and if .F. (false)
   // it is opened in the current work area, closing any file already occupying that area. 
   // DbCreate( <cDatabase> , ;
   //           <aStructure>, ;
   //          [<cDriver>]  , ;
   //          [<lNewArea>] , ;
   //          [<cAlias>]     ) --> NIL

   DbCreate( "mem:Teste.DBF", aLayOut, "DBFCDX" , .T., "Teste" )

   // Criar índice em memória
   // OrdCreate( <cIndexFile> , ;
   //           [<cIndexName>], ;
   //            <cIndexExpr> , ;
   //            <bIndexExpr> , ;
   //           [<lUnique>]     ) --> NIL

   OrdCreate( "mem:Teste, "mem_cod", "mem_cod"  )

   Browse()

   DbCloseArea()

   DbDrop( "mem:Teste.DBF", "DBFCDX" )  /* Free memory resource */
   DbDrop( "mem:Teste.CDX", "DBFCDX" )  /* Free memory resource */

RETURN NIL