Acabei tendo que criar uma rotina para converter os arquivos.
* campos duplicados podem ser o 1o ou o 2o com a informação.
Código: Selecionar todos
procedure main()
SET CENTURY ON
SET DATE TO FRENC
SET WRAP ON
CLS
vArq:=[.\converte.txt]
* SET CONSOLE OFF
SET ALTERNATE TO &vArq
SET ALTERNATE ON
ChecaStru()
SET ALTERNATE TO
set color to b/w
cls
READTEXT(vArq)
quit
* Rotina para verificar se o DBF tem campos duplicados em sua estrutura
* Se houver a rotina ira criar uma copia no subdiretorio ok
* ira criar uma nova estrutura(dbf) sem os campos duplicados
* ira fazer um replace campo a campo e nos registros duplicados
* fara uma checagem de conteudo procurando preservar a informação
* usa-se o fieldget com a posição do campo e checa qual dois fields
* duplicados tem informação e da um replace
* se usar o append from este não preserva os dados de campos duplicados
* campos duplicados podem ser o 1o ou o 2o com a informação.
*
* Autor: Edmar FrazÆo (11/02/2008)
////////////////////////////////////////////////////////
Function ChecaStru()
Local I,T
Private vConvert:=0
cls
IF !ISDirectory( '.\OK' )
vComando:="md .\ok"
run &vComando
? ""
? " Foi criado um diretorio .\ok"
? " para os arquivos com erro de estrutura serem copiados"
? " "
? " execute a conversÆo novamente"
? ""
quit
ENDIF
? 'Verificando estrutura dos arquivos'
? ''
PRIVATE vDBF[adir([*.DBF])]
ADIR([*.DBF],vDBF)
? 'Existem '+STr(len(vDBF),5)+' arquivos'
? ''
FOR I:=1 TO LEN(vDBF)
xArq:=vDBF[i]
use &xArq
vStru:=DbStruct()
vNovaStru:={}
vStruDupl:={}
Valid_Estru(vSTRu)
if Len(vStruDupl)>0 //Somente Strutura Duplicada
if cvArquivo(xArq,vNovaStru)
? 'Arquivo:'+xArq
? ''
? 'Campos da Strutura -> Antiga='
?? Len(vStru)
?? ' Nova='
?? Len(vNovaStru)
?? ' Duplicados='
?? int(Len(vStruDupl)/2)
FOR T:=1 TO len(vStruDupl)
? 'Campo Duplicado '+vStruDupl[T,1]
NEXT
? ''
endif
ENDIF
close all
NEXT
? ''
? 'Arquivos convertidos '
?? Str(vConvert)
? ''
return nil
static function Valid_Estru(xEstru)
Local I,A
Private sStru,vEstru:= xEstru,vEstru1:={} //,vStruDupl:={}
FOR I:=1 TO LEN(vEstru)
AADD(vEstru1,{vEstru[i,1],0})
next
FOR I:=1 TO len(vEstru1)
for a:=1 to len(vEstru)
if vestru1[i,1]==vEstru[a,1]
vEstru1[i,2]:= vEstru1[i,2]+1
endif
NEXT
NEXT
FOR I:=1 TO len(vEstru1)
IF VESTRU1[I,2]#1
AADD(vStruDupl,vEstru[i])
ELSE
sStru:=xEstru[i]
aadd(vNovaStru,sStru)
endif
next
vNovS:={}
IF len(vStruDupl)>0
FOR I:=1 TO LEN(vStruDupl)
vAchou:=.f.
//Pesquisa se na estrutura nova tem o campo
// se nÆo tem o inclui e evita incluilo duplicado
FOR B:=1 TO LEN(vNovaStru)
IF vStruDupl[I,1]=vNovaStru[B,1]
vAchou:=.t.
ENDIF
NEXT
if !vAchou
AADD(vNovaStru,vStruDupl[i])
endif
NEXT
endif
return nil
static function cvArquivo(vArq,vStru)
Local xArq:=vArq+[.dbf],vRet:=.f.,XA,vCampo,xCopia
xNovArq:='.\ok\'+varq
if File(xnovArq)
? ''
? 'Arquivo de copia ja existe '+xNovArq +' conversÆo nÆo executada'
? ''
else
CLOSE
vComando:="COPY "+vArq + " OK"
run &vComando
xCopia:=".\OK\"+vArq
IF !FILE(xCopia)
? "erro na copia do arquivo "
?? xCopia
else
if ferase(vArq)>0
? 'Erro na exclusÆo do arquivo '+vARq
else
close
DBCREATE(vArq,vStru)
USE &vArq alias ORIG NEW
use &xNovArq ALIAS COPIA NEW
//Retorna a posi‡Æo do Field no DBF para buscar a informa‡Æo
xRegDupl:=Busc_Dupl(DbStruct())
DBGOTOP()
WHILE !EOF()
SELECT ORIG
DBAPPEND()
FOR I:=1 TO len(vStru)
vCampo:=vStru[i,1]
campo:=COPIA->&vCampo
replace &vCampo with Campo
FOR B:=1 TO LEN(xRegDupl)
if xRegDupl[B,1]=vCampo
vCampo1:= COPIA->(FieldGet(xRegDupl[B,2]))
vCampo2:= COPIA->(FieldGet(xRegDupl[B,3]))
IF EMPTY(vCampo1)
xCampo:=vCampo2
else
xCampo:=vCampo1
endif
replace &vCampo with xCampo
exit
endif
NEXT
NEXT
SELECT COPIA
DBSKIP()
END
CLOSE ALL
//Converter
vRet:=.t.
? ' Arquivo convertido'
vConvert ++
? ' '
endif
endif
endif
return vRet
static function Busc_Dupl(xEstru)
Local I,A
Local vNovaStru:={}
Private sStru,vEstru:= xEstru,vEstru1:={},vStruDupl:={}
FOR I:=1 TO LEN(vEstru)
AADD(vEstru1,{vEstru[i,1],0})
next
FOR I:=1 TO len(vEstru1)
for a:=1 to len(vEstru)
if vestru1[i,1]==vEstru[a,1]
vEstru1[i,2]:= vEstru1[i,2]+1
endif
NEXT
NEXT
FOR I:=1 TO len(vEstru1)
IF VESTRU1[I,2]#1
AADD(vStruDupl,vEstru[i])
ELSE
sStru:=xEstru[i]
aadd(vNovaStru,sStru)
endif
next
vNovS:={}
sRegDu:={}
IF len(vStruDupl)>0
FOR I:=1 TO LEN(vStruDupl)
vAchou:=.f.
//Pesquisa se na estrutura nova tem o campo
// se nÆo tem o inclui e evita incluilo duplicado
FOR B:=1 TO LEN(vNovaStru)
IF vStruDupl[I,1]=vNovaStru[B,1]
vAchou:=.t.
ENDIF
NEXT
if !vAchou
AADD(vNovaStru,vStruDupl[i])
AADD(sRegDu,{vStruDupl[i,1],0,0,0})
endif
NEXT
endif
FOR I:=1 TO LEN(sRegDu)
FOR B:=1 TO LEN(xEstru)
IF sRegDU[I,1]=xEstru[B,1]
vPos:=2
IF sRegDu[i,2]=0
vPos:=2
elseif sRegDu[i,3]=0
vPos:=3
elseif sRegDu[i,4]=0
vPos:=4
endif
sRegDu[i,vPos] := B
ENDIF
NEXT
NEXT
return sRegDu
////////////////////////////////////////////////////////
//Rotina para visualizar os arquivos convertidos
////////////////////////////////////////////////////////
FUNCTION READTEXT
*****************************************************************
* Apresenta um arq. texto de qualquer tamanho em uma janela p/leitura.
# include "box.ch"
# include "inkey.ch"
# define wind_rows (bottom - top) - 1 // window rows
# define wind_cols (right - left) - 2 // window columns
Local xRetorno:=.t.,vArea:=Alias()
LOCAL counter := 0, old_cursor := SETCURSOR(0), old_screen := ''
PRIVATE text_array := {}, col_offset := 1, keypress := 0
PARAMETERS text_file, top, left, bottom, right, start_line
* Inicializa argumentos nao especificados com parametros predefinidos.
top = IF(top = NIL, 0, top)
left = IF(left = NIL, 0, left)
bottom = IF(bottom = NIL, MAXROW(), bottom)
right = IF(right = NIL, MAXCOL(), right)
private xLinux:=.F.
#ifdef Harbour
if "LINUX" inUPPER(OS())
xLinux:=.T.
ENDIF
#endif
PRIVATE xFimLinha
IF xLinux
xFimLinha:=CHR(10)
ELSE
xFimLinha:=CHR(13)+CHR(10)
ENDIF
start_line = IF(start_line = NIL, 1, start_line)
* Se o arquivo nao puder ser aberto, encerra a funcao.
IF (handle := FOPEN(text_file)) > 0
* Grava a tela antiga e a area de texto delimitada por uma moldura.
@ 00,0 SAY PADC([Visualiza‡„o de Relat¢rio],80) color([W+/B+])
* @ top, left, bottom, right BOX B_SINGLE + SPACE(1)
* Grava o valor de final do arquivo.
text_eof = FSEEK(handle, 0, 2)
* Declara array de visual. como numero linhas da janela por 2 cols.
* Colunas: 1 = ponteiro do arquivo, 2 = texto da linha
text_array := array(wind_rows,2)
IF start_line > 1
FOR counter = 1 TO (start_line)
* Move o ponteiro do arquivo para a linha especificada.
FREADLINE(handle)
NEXT
ENDIF
* Carrega o array e apresenta a janela inicial com as linhas.
FILL_ARRAY()
DISP_ARRAY()
* Processa as teclas pressionadas e reapresenta o array.
PROCESS_KEY()
* Recupera a tela antiga e fecha o arquivo.
FCLOSE(handle)
ENDIF
SETCURSOR(old_cursor)
RETURN NIL
*****************************************************************
STATIC FUNCTION PROCESS_KEY
*****************************************************************
* Processa as teclas para movimentacao da janela.
LOCAL buffer := SPACE(512), line_end := line_num := pointer := 0
FSEEK(handle, 0)
pointer = FSEEK(handle,0,0)
FILL_ARRAY()
keypress = DISP_ARRAY()
@ 24,20 SAY [Tecle <ALT_P> p/ imprimir o Relatorio]
nLinha:=7
DO WHILE keypress != K_ESC //.OR. (keypress!=K_RBUTTONDOWN)
* Se a tecla for valida, e' processada.
IF keypress= 1004
EXIT
ENDIF
IF keypress = K_UP .OR. keypress = K_DOWN .OR. ;
keypress = K_HOME .OR. keypress = K_END .OR. ;
keypress = K_PGUP .OR. keypress = K_PGDN .OR. ;
keypress = K_LEFT .OR. keypress = K_RIGHT .OR. ;
keypress = K_CTRL_LEFT .OR. keypress = K_CTRL_RIGHT .OR. ;
keypress = K_ENTER .OR. KEYPRESS= K_F10 .OR. ;
KEYPRESS= K_F11 .OR. KEYPRESS= K_F12 .OR. ;
KEYPRESS= K_F1 .OR. KEYPRESS= K_F2 .OR. ;
KEYPRESS= K_ALT_A .OR. KEYPRESS= K_F9
* Move 1 linha ou 1 tela para cima.
IF KEYPRESS = K_F10
ELSEIF keypress = K_UP .OR. keypress = K_PGUP
IF text_array[1][1] != 0 // Inicio do arquivo
* Move ponteiro do arquivo p/ a linha superior do array
pointer = FSEEK(handle, text_array[1][1], 0)
* Guarda ponteiro do arquivo (linha ou janela de tela)
pointer = REWIND(handle, IF(keypress = K_UP, ;
1, wind_rows), pointer)
* E recarrega o array.
FILL_ARRAY()
ENDIF
* Move 1 linha ou 1 tela para baixo.
ELSEIF keypress = K_DOWN .OR. keypress = K_PGDN
* Verifica se esta' no final do arquivo.
IF FSEEK(handle,0,1) != text_eof
* Se nao for EOF nem BOF, recarrega o array.
IF keypress = K_DOWN
* Move ponteiro p/ segundo elem. do array.
FSEEK(handle, text_array[2][1], 0)
ENDIF
FILL_ARRAY()
ENDIF
* Move para o inicio do arquivo.
ELSEIF keypress = K_HOME
pointer = FSEEK(handle,0,0)
FILL_ARRAY()
* Move para o final do arquivo.
ELSEIF keypress = K_END
pointer = FSEEK(handle,0,2)
* Move o ponteiro uma janela de tela para tras.
pointer = REWIND(handle, wind_rows, pointer)
FILL_ARRAY()
* Move a janela 1 coluna `a direita.
ELSEIF keypress = K_RIGHT
col_offset := IF(col_offset < 512,col_offset+8, 512)
* Move a janela 1 coluna `a esquerda.
ELSEIF keypress = K_LEFT
col_offset := IF(col_offset > 8, col_offset-8, 1)
* Move a janela 8 colunas `a direita.
ELSEIF keypress = K_CTRL_RIGHT
col_offset := IF(col_offset < 512,col_offset+8, 512)
// col_offset := IF(col_offset < 512,++col_offset, 512)
* Move a janela 8 colunas `a esquerda.
ELSEIF keypress = K_CTRL_LEFT
col_offset := IF(col_offset > 8, col_offset-8, 1)
// col_offset := IF(col_offset > 1, --col_offset, 1)
* Reinicializa o desloc. da janela p/ primeira coluna.
ELSEIF keypress = K_ENTER
col_offset := 1
ENDIF
* Reapresenta o array.
keypress = DISP_ARRAY()
ELSE
// NOVO
@ 0,79 SAY CHR(30)
@ 24,79 SAY CHR(31)
While .T.
@ 23,78 SAY [ ]
@ 1,78 CLEAR TO 22,79
@ 1,79 TO 23,79
keypress = DISP_ARRAY()
//Mostra a linha atual em cor diferente
@ nlinha, left + 2 SAY ;
SUBSTR(text_array[nLinha][2], col_offset, wind_cols) COLOR([W+/N*])
do while ( keypress :=inkey(0)) == 0
#ifdef xHarbour
inkey(.1)
#else
OL_yield()
#endif
enddo
IF keypress= K_UP
nLinha --
ELSEIF keypress= K_DOWN
nLinha ++
ELSE
EXIT
ENDIF
if (nLinha >=22)
nLinha:=22
exit
elseif (nLinha<=1)
nLinha:=1
exit
endif
END
IF keypress= 502
EXIT
ENDIF
// keypress := INKEY(0) // se for usado inkey(0), sobrecarrega a cpu
* Se a tecla nao for valida, obtem outra.
ENDIF
ENDDO
RETURN NIL
*****************************************************************
STATIC FUNCTION FILL_ARRAY
*****************************************************************
* Carrega o array de visualizacao c/ o ponteiro e o texto de cada linha.
LOCAL counter := 1
FOR counter = 1 TO (wind_rows)
text_array[counter][1] := FSEEK(handle, 0, 1)
text_array[counter][2] := FREADLINE(handle)
IF FSEEK(handle, 0, 1) >= text_eof ; EXIT ; ENDIF
NEXT
* Se for EOF, preenche o balanceamento do array com valores ficticios.
IF counter++ < wind_rows
FOR counter = counter TO wind_rows
text_array[counter][1] := text_eof
text_array[counter][2] := ''
NEXT
ENDIF
RETURN NIL
*****************************************************************
STATIC FUNCTION DISP_ARRAY
*****************************************************************
* Mostra array. Retorna imediatamente se uma tecla nao for pressionada.
LOCAL counter := 1, disp_string
* Apaga o buffer do teclado e a area da janela.
CLEAR TYPEAHEAD
@ top+1, left+2 CLEAR TO bottom-1, right-2
* Mostra linhas da janela ate' terminar ou uma tecla ser pressionada.
DO WHILE (keypress := INKEY()) = 0 .AND. counter <= wind_rows
* Apresenta a cadeia e incrementa o contador de linhas.
IF MOD(COUNTER,2)=1
@ (top + counter), left + 2 SAY ;
SUBSTR(text_array[counter][2], col_offset, wind_cols)
ELSE
@ (top + counter), left + 2 SAY ;
SUBSTR(text_array[counter][2], col_offset, wind_cols)
ENDIF
counter++
ENDDO
RETURN keypress
*****************************************************************
STATIC FUNCTION REWIND (handle, num_lines, pointer)
*****************************************************************
* Move o ponteiro do arquivo para tras do numero de linhas especificado.
LOCAL buffer := SPACE(512), first_line := .F., line_end := 0
Local xContador:=0
DO WHILE num_lines > 0
xContador ++
if xContador>5 // Retira Bug de Gde no de colunas
exit
endif
* Apaga o buffer.
buffer := SPACE(512)
IF pointer >= 514
* Move o ponteiro 514 bytes para tras.
FSEEK(handle, -514, 1)
* Preenche buffer sem retorno de carro/avanco de linha (CR/LF).
FREAD(handle, @buffer, 512)
ELSE
* Move o ponteiro para BOF e carrega texto restante.
FSEEK(handle, -pointer, 1)
FREAD(handle, @buffer, pointer-2)
* Ativa sinaliz. primeira linha se nao ha' CR/LF no buffer.
buffer = TRIM(buffer)
first_line := IF(AT(xFimLinha, buffer) > 0,.F.,.T.)
ENDIF
* Verifica a existencia de um CR/LF anterior.
DO WHILE (line_end := RAT(xFimLinha, buffer)) > 0 ;
.AND. num_lines > 0
* Move o ponteiro para o final da linha anterior.
pointer = FSEEK(handle, -(LEN(buffer)-(line_end-1)), 1)
* Retira linha do buffer e decrementa numero restante.
buffer = SUBSTR(buffer, 1, line_end - 1)
num_lines--
ENDDO
IF ! first_line
* Move ponteiro para inicio da proxima linha (salta CR/LF)
pointer = FSEEK(handle, 2, 1)
ELSE
* Reinicializa ponteiro para BOF e encerra operacao.
FSEEK(handle, 0, 0)
EXIT
ENDIF
ENDDO
RETURN pointer
STATIC FUNCTION ACENTOS()
RETURN .T.
*****************************************************************
FUNCTION FREADLINE (handle, line_len)
Local xAnt,xLin
*****************************************************************
* Carrega uma linha de um arq. texto (a partir da pos.atual do ponteiro)
* Copyright(c) 1991 -- James Occhiogrosso
# define MAXLINE 512
LOCAL buffer, line_end, num_bytes
* Se o tamanho da linha nao for informado, usa o predefinido MAXLINE
IF VALTYPE(line_len) != 'N'
line_len = MAXLINE
ENDIF
* Define um buffer temporario p/ guardar o tamanho de linha
* especificado
buffer = SPACE(line_len)
* Carrega o texto da posicao atual ate' o tamanho de linha especificado
num_bytes = FREAD(handle, @buffer, line_len)
* Localiza a combinacao de retorno de carro/avanco de linha.
line_end = AT(xFimLinha, buffer)
//line_end = AT(CHR(10), buffer) // Final da Linha
//xAnt:=Subst(buffer,line_end-1,1)
//xLin:=.T.
//if asc(xAnt)=32
// line_end = AT(CHR(13)+CHR(10), buffer)
//elseif asc(xAnt)=13
// line_end = AT(CHR(13)+CHR(10), buffer)
// xLin:=.F.
//endif
IF line_end = 0
* Nao ha' retorno carro/avanco linha. Ponteiro esta' no final do
* arq. ou linha e' grande demais. Volta ponteiro p/ inicio do arq.
//FSEEK(handle, 0)
RETURN('')
ELSE
if xLinux
* Move o ponteiro para o inicio da proxima linha.
FSEEK(handle, (num_bytes * -1) + line_end , 1)
else
* Move o ponteiro para o inicio da proxima linha.
FSEEK(handle, (num_bytes * -1) + line_end + 1, 1)
endif
* E retorna a linha atual.
RETURN( SUBSTR(buffer, 1, line_end -1) )
ENDIF
FUNCTION IGUAL_VAR(TIPOVAR) &&F027
LOCAL NOMECAMPO,NOMEVAR,I,A
IF TIPOVAR=NIL
TIPOVAR="V_"
ENDIF
A=FCOUNT()
FOR I = 1 TO A
NOMECAMPO=FIELDNAME(I)
NOMEVAR=TIPOVAR+NOMECAMPO
PUBLIC &NOMEVAR
&NOMEVAR=&NOMECAMPO
NEXT
RETURN NIL
FUNCTION INIC_VAR(TIPOVAR)
LOCAL NOMECAMPO,NOMEVAR,I,A
IF TIPOVAR=NIL
TIPOVAR="V_"
ENDIF
A=FCOUNT()
FOR I = 1 TO A
NOMECAMPO=FIELDNAME(I)
NOMEVAR=TIPOVAR+NOMECAMPO
PUBLIC &NOMEVAR
DO CASE
CASE TYPE(FIELD(I))="C"
&NOMEVAR=SPACE(LEN(&NOMECAMPO))
CASE TYPE(FIELD(I))="N"
&NOMEVAR=0
CASE TYPE(FIELD(I))="D"
&NOMEVAR=CTOD(" / / ")
CASE TYPE(FIELD(I))="L"
&NOMEVAR=.F.
CASE TYPE(FIELD(I))="M"
&NOMEVAR=SPACE(10)
ENDCASE
NEXT
RETURN NIL
