Como checar DBF se tem campos duplicados e corrigi-los.

[edmarfrazao]

Quem tem uma rotina para checar DBF se tem campos duplicados, e corrigi-los?


tenho alguns DBf que estão com campos duplicados na sua estrutura.


Alguem tem algo que possa corrigi-los automaticamente?


tenho alguns DBf que estão com campos duplicados na sua estrutura.


Alguem tem algo que possa corrigi-los automaticamente?

[Clipper]

Prezado Colega

Tente esse utilitário :

http://www.cratchit.org/download/fixdbf.zip

Até logo.

Marcelo

[jairfab]

Amigo, eu so nao entendir como você conseguiu duplicar campos, registros tudo bem seria muito facil, mas campos????

[Maligno]

Também reparei no detalhe quando li essa mensagem. Acho que o Edmar trocou a palavra "registro" por "campo". Deve ser isso.

[Maligno]

Aliás, em tempo: pra procurar registros duplicados e evitar ter que comparar campo a campo, registro a registro, acho que seria mais fácil gerar um novo
índice cuja chave seria o CRC32 do registro. Aí seria só percorrer o índice e fazer uma comparação simples.

[sygecom]

Amigo, eu so nao entendir como você conseguiu duplicar campos, registros tudo bem seria muito facil, mas campos????

Se vc usar o DBCREATE() para criar os DBF e colocar um campo com o mesmo nome ele aceita sem problema algum no xharbour.

[Maligno]

Seria uma terrível falha do programador.

[edmarfrazao]

o que esta duplicado são os campos mesmos.


como o meu sistema tem varios anos(18) anos, durante este tempo a estrutura vai mudando.

Então tinha um pequeno programa para alterar a estrutura.


O problema e que o programa de conversão foi ficando grande e acontecei por erro campos duplicados no dbf.


hoje corrigi a rotina , se eu cometer o mesmo erro o meu converte de estruturas não converte a tabela e me mostra o erro.


O problema e que tenho varias empresa com campos duplicados.
O problema so aparece quando converto novamente a tabela ai.

para corrigir o problema tenho que criar uma nova tabela da append registro a registro e dar um replace no campo, pois o append from não consegue buscar os dados do campo duplicado.

Ja postei este problema para o pessoal do xharbour não deixar isto acontecer mais, mais não disseram que iriam arrumar ou não.

Alguem conhece algum utilitario que corrigiria o problema de campos duplicados?


Alias so descobri o problema, pois estou fazendo teste com o SQLRDD e ele abre a estrutura do dbf e cria o banco de dados no firebird e da erro pois no BD não pode ter dois campos com o mesmo nome.

[Clipper]

Prezado Colega

Neste caso creio que a melhor solução é fazer a alteração com um Editor Hexadecimal.

Fiz o seguinte teste aqui :

Editei em hexadecimal um arquivo de clientes com 8.500 registros, nele havia um campo chamado TELEFONEC e um outro chamado TELEFONER, mudei de TELEFONEC para TELEFONER, sendo assim ficou com 2 campos chamados TELEFONER, abri com o DBU normalmente, inseri alguns registros e fechei normalmente, então creio que ao inverso também deve funcionar.

Creio eu que também deve ser algo fácil de fazer usando as funções de baixo nível caso se faça necessário.

Até logo.

Marcelo

[Clipper]

Prezado Edmar

Editado em 11.02.2008 as 16:01

Resolvi fazer uma rotina que faça isso usando o bom e velho Clipper mesmo.

Foram feitas melhorias na função, quem quiser acompanhar ou pegar a versão nova, no tópico abaixo :

https://pctoledo.org/forum/viewtopic.php?t=7471

Até logo.

Marcelo

[rochinha]

Amiguinhos

Na verdade esta falha ja vem do Clipper. Eu já tive este problema em alguns .DBF com muitos campos onde acabava criando mais um com o mesmo nome ou pelo fato de usar nomes de campos muito grandes e ao serem truncados na criação ababarem gerando campos de mesmo nome.

Isto pode passar batido se o campo não fizer parte de uma chave de indice o que pode causar corrompimento da base.

E se este problema ainda existe no xHarbour ai sim existe um erro de programador.

Inclusive outro problema que tive com Harbour(não sei quanto ao X) era o fato de não poder mudar a extensão do .DBF.

Eu até poderia criar a estrutura com uma extensão diferente tipo, CLIENTES.123, mas ao tentar abrir o mesmo juntamente com o CLIENTES.DBF, mesmo usando ALIAS, tinha resposta de erro de que o mesmo ja estava aberto ou não era encontrado.

Bom mas resolvi de outra forma que nem lembro.

[Clipper]

Resolvi fazer uma função genérica que possa ser usada por todos.

Dependendo do tamanho do arquivo essa pesquisa pode demorar um pouco, no teste que fiz com um arquivo de 4 MB demorou 43 segundos, em pesquisas com arquivos grandes é interessante colocar uma barra de progresso ou algo parecido.

Segue abaixo o código :

Código: Selecionar todos

*** Pesquisa a existencia de um determinado texto dentro de um arquivo
*** O arquivo pode ter qualquer extensao
***
*** Parametros
*** cArq   = Nome do arquivo a ser pesquisado
*** cPesq  = Cadeia a ser pesquisada 
*** cTroca = Caso seja informado ao encontrar a sequencia sera feita a troca 
***
*** Retorno :
*** Retorna a quantidade de ocorrencias
*** Em caso de erro retorna -1, -2 ou -3 dependendo do erro

*------------------------------------*
 Function PesqByte(cArq,cPesq,cTroca)
*------------------------------------*
if cArq=nil .or. cPesq=nil // Falta de parametros
   return(-1)
endif
if cTroca<>nil
   if len(cPesq)<>len(cTroca) // Tamanhos diferentes
      return(-2)
   endif
endif
if .not. file(alltrim(cArq)) // Arquivo nao encontrado
   return(-3)
endif

hand=fopen(cArq,2)
Byte=1
Tamanho=fseek(hand,0,2)
posiciona=fseek(hand,0,0)
conta=0
do whil .T.
   leu=freadstr(hand,len(cPesq))
   if leu=cPesq
      conta++
      if cTroca<>nil
         fseek(hand,-len(cPesq),1)
         fwrite(hand,cTroca,len(cTroca))
      endif
   endif
   byteatual=fseek(hand,-len(cPesq)+1,1)
   byte++
   if byte>=tamanho-len(cPesq)+1
      fclose(hand)
      return(conta)
   endif
enddo

Até logo.

Marcelo

[rochinha]

Amiguinhos

Eu ja penso em outra forma, uso de 2 vetores.

O primeiro contera a estrutura do arquivo sendo verificado, usando DBStructure().
O segundo armazenará os nomes de campos e a quantidade existente do mesmo na estrutura avaliada.

- Um laço percorre o primeiro pegando os nomes de campo
- Passa para o segundo vetor, faz um Ascan()
- Se Não encontrou o nome de campo adiciona um elemento ao segundo vetor com nome e quantidade 1
- Se encontrou o nome de campo, soma mais um a quantidade existente
- Finalmente faz uma varredura no segundo vetor afim de apresentar os campos com quantidade maior que 1.

As perguntas que ficam são:

- Ao sofrer um REPLACE os dados são armazenados somente no primeiro campo?
- Ao sofrer um REPLACE os dados são armazenados nos dois campos?
- Ao sofrer um REPLACE os dados podem ser armazenados em um e em outra ocasião no outro campo?
- O Sal é grosso porque não tem educação?
- A frente é fria porque tem costas quente?


Oooops!!! )

[edmarfrazao]

Acabei tendo que criar uma rotina para converter os arquivos.

* 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.
*
segue abaixo.


como usei os comandos fieldget(so vai funciona no xharbour)

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