Conversão de Tabelas DBF.

10/05/2003

0

Delphi

Olá pessoal!
Possuo uma tabela Dbase chamada MATERIAL.DBF de um programa antigo em Clipper e gostaria de convertê-la para Interbase e criei um programinha para isto.
Porém quando eu abro esta tabela antiga em um Dbgrid para eu acompanhar o andamento do processo os caracteres acentuados aparecem desformatados e são gravados assim na tabela Interbase, vejam:

COMO APARECE / COMO DEVERIA APARECER

CONSULTàRIO MDICO / CONSULTÓRIO MÉDICO
HORTÒNCIA / HORTÊNCIA
FLµVIO / FLÁVIO
GRA€AS / GRAÇAS
PUN€ÇO / PUNÇÃO
SECRE€ÇO / SECREÇÃO

Como faço para mostrar os dados desta tabela Dbase agora no Windows como eles aparecem no bom e velho DOS?
Obrigado,

[color=red:857ad57d99][b:857ad57d99][i:857ad57d99]Título em maiúsculas editado. Leia as regras de conduta. (marcelo.c - Moderador)[/i:857ad57d99][/b:857ad57d99][/color:857ad57d99]


Weliton Oliveira

Weliton Oliveira

Responder

Posts

11/05/2003

Aroldo Zanela

Colega,

Já faz tanto tempo que eu não passo por isso que não me lembro exatamente como fiz para resolver esses problemas.

Peguei um código em VB para servir de base para você construir uma rotina apropriada. Eu tenho quase certeza que tem uma ferramenta para isso, mas realmente não me lembro e não encontrei outra saída:

REMOVENDO ACENTOS DE PALAVRAS

Aqui temos 7 exemplos diferentes com a mesma finalidade.
As 7 são de 4 autores: Ribamar FS, Carlos Manuel e José Luiz e Rogério
Deixei as versões anteriores para mostrar a evolução do código.

Function SemAcentos(sString As String)
    Dim x As Integer
    Dim l(30) As String ´Supondo que a maior palavra tem 30 caracteres
    
    If Len(sString) > 30 Then
        MsgBox "A palavra excede o tamanho suportado!"
        Exit Function
    End If
    
    For x = 0 To Len(sString) - 1
        l(x) = Mid(sString, x + 1, 1)
        If Asc(l(x)) >= 192 Then    ´Acentuados tem código >=192
            Select Case l(x)
                Case "ã"
                    l(x) = "a"
                Case "á"
                    l(x) = "a"
                Case "é"
                    l(x) = "e"
                Case "ê"
                    l(x) = "e"
                Case "í"
                    l(x) = "i"
                Case "ó"
                    l(x) = "o"
                Case "ô"
                    l(x) = "o"
                Case "õ"
                    l(x) = "o"
                Case "ü"
                    l(x) = "u"
                Case "ú"
                    l(x) = "u"
                Case "ç"
                    l(x) = "c"
                Case Else
            End Select
        End If
    Next x
    SemAcentos = l(0) + l(1) + l(2) + l(3) + l(4) + l(5) + l(6) + l(7) + l(8) + l(9) + _
        l(10) + l(11) + l(12) + l(13) + l(14) + l(15) + l(16) + l(17) + l(18) + l(19) + l(20) + _
        l(21) + l(22) + l(23) + l(24) + l(25) + l(26) + l(27) + l(28) + l(29)
End Function

Private Sub cmdSemAcentos_Click()
    txtSemAcentos = SemAcentos(txtSemAcentos)
End Sub


REMOVENDO ACENTOS DE PALAVRAS -VERSÃ0 2

Function SemAcentos(sString As String)
    Dim x As Integer
    Dim sStringFinal As String
    
    Dim letra() As String
    
    For x = 0 To Len(sString) - 1
    ReDim Preserve letra(x)
        letra(x) = Mid(sString, x + 1, 1)
        
        If Asc(letra(x)) >= 192 Then    ´Acentuados tem código >=192
            Select Case letra(x)
                Case "ã", "á"
                    letra(x) = "a"
                Case "é", "ê"
                    letra(x) = "e"
                Case "í"
                    letra(x) = "i"
                Case "ó", "ô", "õ"
                    letra(x) = "o"
                Case "ü", "ú"
                    letra(x) = "u"
                Case "ç"
                    letra(x) = "c"
                Case Else
            End Select
        End If
    Next x
    
    For x = 0 To Len(sString) - 1
        sStringFinal = sStringFinal + letra(x)
    Next x
    
    SemAcentos = sStringFinal
End Function

Private Sub cmdSemAcentos_Click()
    txtSemAcentos = SemAcentos(txtSemAcentos)
End Sub


REMOVENDO ACENTOS DE PALAVRAS -VERSÃ0 3

Esta versão foi desenvolvida pelo colega Carlos Manoel (disgrace@visto.com)
da lista access-pt.

Private Function Subs(letra As String) As String
    Select Case letra
        Case "ã"
            Subs = "a"
        Case "á"
            Subs = "a"
        Case "é"
            Subs = "e"
        Case "ê"
            Subs = "e"
        Case "í"
            Subs = "i"
        Case "ó"
            Subs = "o"
        Case "ô"
            Subs = "o"
        Case "õ"
            Subs = "o"
        Case "ü"
            Subs = "u"
        Case "ú"
            Subs = "u"
        Case "ç"
            Subs = "c"
        Case Else
            Subs = letra
        End Select

End Function

Function SemAcentos(texto As String) As String
    Dim x As Integer, caracter As String
    
    ´texto=Trim(texto)
    SemAcentos = texto
    For x = 1 To Len(texto)
        caracter = Mid(texto, x, 1)
        If Asc(caracter) >= 192 Then
            SemAcentos = Left(SemAcentos, x - 1) & Subs(caracter) & Right(SemAcentos, Len(texto) - x)
        End If
    Next x
    
End Function


REMOVENDO ACENTOS DE PALAVRAS -VERSÃ0 4

Function SemAcentos(sString As String) As String
´Função original criada por Ribamar F. S. (ribafs@yahoo.com)
´adaptada em 20/04/01 por José Luiz de Souza Gomes (jlsgomes@uem.br)
    
    
    Dim x As Integer
    Dim strnew As String
    
    ´Para Strings de qualquer tamanho
    ReDim l(Len(sString)) As String
    
    ´inicializa a variável strnew com uma seqüência nula
    strnew = ""
    
    ´Percorre o campo caractere a caractere, até o final
    For x = 0 To Len(Trim(sString)) - 1
        l(x) = Mid(sString, x + 1, 1)
        If Asc(l(x)) >= 192 Then   ´Os caracteres acentuados são maiores
que
192
            ´concatena (junta) cada letra com a anterior para formar a
nova
string
            strnew = strnew & TrocaLetra(l(x))
        Else
            strnew = strnew & l(x)
        End If
    Next x
    
    ´Retorna a nova string
    SemAcentos = strnew
    
    ´para uso com DBF ou Clipper, pode-se converter para maiúsculas,
assim:
    ´SemAcentos = UCase(strnew)
    
End Function
            
Function TrocaLetra(s As String) As String
´função complementar à rotina que toma uma String que contém acentos e
´transforma cada letra acentuada em sua equivalente sem acento
´Criada por Ribamar F. S (ribafs@yahoo.com)
´Adaptada por: José Luiz de Souza Gomes (jlsgomes@uem.br)
   
   Dim LetraSemAcento As String
   
   Select Case s
          Case "ã"
             LetraSemAcento = "a"
          Case "á"
             LetraSemAcento = "a"
          Case "é"
             LetraSemAcento = "e"
          Case "ê"
             LetraSemAcento = "e"
          Case "í"
             LetraSemAcento = "i"
          Case "ó"
             LetraSemAcento = "o"
          Case "ô"
             LetraSemAcento = "o"
          Case "õ"
             LetraSemAcento = "o"
          Case "ü"
             LetraSemAcento = "u"
          Case "ú"
             LetraSemAcento = "u"
          Case "ç"
             LetraSemAcento = "c"
          Case Else
      End Select
      TrocaLetra = LetraSemAcento
End Function


REMOVENDO ACENTOS DE PALAVRAS -VERSÃ0 5

Esta versão foi desenvolvida pelo colega Carlos Manoel (disgrace@visto.com)
da lista access-pt.

Private Function Subs(Cod As Integer) As String

    Select Case Cod
        Case 224 To 228
            Subs = "a"
        Case 232 To 235
            Subs = "e"
        Case 236 To 239
            Subs = "i"
        Case 242 To 246
            Subs = "o"
        Case 249 To 252
            Subs = "u"
        Case 231
            Subs = "c"
        Case 241
            Subs = "n"
        Case Else
            Subs = Chr$(Cod)
        End Select

End Function

Function SemAcentos(texto As String) As String
    Dim x As Integer, caracter As Integer
    
    texto = Trim(texto)
    SemAcentos = texto
    For x = 1 To Len(texto)
        caracter = Asc(Mid(texto, x, 1))
        If caracter >= 192 Then
            SemAcentos = Left(SemAcentos, x - 1) & Subs(caracter) & Right(SemAcentos, Len(texto) - x)
        End If
    Next x
    
End Function


REMOVENDO ACENTOS DE PALAVRAS -VERSÃ0 6

Function SemAcentos(sString As String) As String
´Função original criada por Ribamar F. S. (ribafs@yahoo.com)
´adaptada em 20/04/01 por José Luiz de Souza Gomes (jlsgomes@uem.br)
    
    
    Dim x As Integer
    Dim strnew As String
    
    ´Para Strings de qualquer tamanho
    ReDim l(Len(sString)) As String
    
    ´inicializa a variável strnew com uma seqüência nula
    strnew = ""
    
    ´Percorre a string, caractere a caractere, até o final
    For x = 0 To Len(Trim(sString)) - 1
        l(x) = Mid(sString, x + 1, 1)
        If Asc(l(x)) >= 192 Then   ´Os caracteres acentuados são maiores
que
192
            ´concatena (junta) cada letra com a anterior para formar a
nova
string
            strnew = strnew & TrocaLetra(l(x))
        Else
            strnew = strnew & l(x)
        End If
    Next x
    
    ´Retorna a nova string
    SemAcentos = strnew
    
    ´para uso com Dbase ou Clipper, pode-se converter para maiúsculas,
assim:
    ´SemAcentos = UCase(strnew)
    
End Function
            
Function TrocaLetra(s As String) As String
´função complementar à rotina que recebe uma String que contém acentos e
´transforma cada letra acentuada em sua equivalente sem acento
´Criada por Ribamar F. S (ribafs@yahoo.com)
´Adaptada por: José Luiz de Souza Gomes (jlsgomes@uem.br)
   
´Algumas formas de acentuação não são usadas na Língua Portuguesa,
´como û ou ë, por exemplo, mas foram incluídas para tentar ser mais
´abrangente.
   
´Bug conhecido: Letras maíusculas acentuadas serão convertidas para
minúsculas
   
   Dim LetraSemAcento As String
   
   Select Case s
          Case "ã", "á", "à", "â", "ä"
               LetraSemAcento = "a"
          Case "é", "ê", "è", "ë"
               LetraSemAcento = "e"
          Case "í", "ì", "î", "ï"
               LetraSemAcento = "i"
          Case "ó", "ò", "ô", "õ", "ö"
               LetraSemAcento = "o"
          Case "ü", "ú", "ù", "û"
               LetraSemAcento = "u"
          Case "ç"
               LetraSemAcento = "c"
          Case Else
   End Select
   TrocaLetra = LetraSemAcento
End Function


REMOVENDO ACENTOS DE PALAVRAS -VERSÃ0 7

Function LimpaAcentos(S As String) As String
´* Objetivo - Retirar os acentos, sem modificar as strings.
´* Parametros -  S - String a ter acentos retirados
´* Adaptada do Algoritmo para Retirar Acentos para Delphi de Marcio 
Castilho
´* Publicada em 08/12/00 para o site da Revista Delphi Journal
´* Adaptacao: Rogerio Olimpio Lourenco de Oliveira - 2000
´* (5120.rogerio@bradesco.com.br)

Dim Acentos1 As String, Acentos2 As String, TMP As String, tmp2 As String
Dim i As Integer, Aux As Integer
    Acentos1 = "ÀÌÒÙÈÁÍÓÚÉÃÏÕÜËÄÖÂÎÔÛÊàìòùèáíóúéãïõüëáöâîôûêÇç"
    Acentos2 = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
    tmp2 = ""
     For i = 1 To Len(S)
        Aux = InStr(1, Acentos1, Mid(S, i, 1), 0)
        If (Aux <= 0) Then
           TMP = Mid(S, i, 1)
        Else
            TMP = Mid(Acentos2, Aux, 1)
        End If
        tmp2 = tmp2 + TMP
    Next i
    LimpaAcentos = tmp2
End Function


http://www.geocities.com/cantinhodemais/RemoverAcentos.txt


Responder
Gostei + 0

13/05/2003

Gustavo Tóla

Existe um Programa que vem junto com o Delphi 6,o DataPump , ele converte vários bancos para o Interbase. Utilize ele que dará certo. Qualquer dúvida de como utilizá-lo pode perguntar.

Gustavo Tóla


Responder
Gostei + 0

Assista grátis a nossa aula inaugural

Assitir aula

Saiba por que programar é uma questão de
sobrevivência e como aprender sem riscos

Assistir agora

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar