(Visual Studio 2008) Lire un fichier ANSEL

Question

Bonjour,

Je dois lire un fichier GEDCOM

S'il est codé en ANSI, pas de problème avec les accents si "System.Text.Encoding.UTF7"

                Using Reader As New Microsoft.VisualBasic.FileIO.TextFieldParser(Me.txtFicPrincipal.Text, System.Text.Encoding.ASCII) ' ASCII DEFAULT UTF7(ANSI) UTF8
                    Reader.TextFieldType = Microsoft.VisualBasic.FileIO.FieldType.FixedWidth
                    While Not Reader.EndOfData
                        Try
                            Me.Ligne1 = Reader.ReadLine

Dans "Me.Ligne1", tout est correct

S'il est codé en ANSEL, comme recommandé dans les logiciels de généalogie, je n'ai pas les caractères accentués

Que ce soit avec " System.Text.Encoding.UTF8" ou " System.Text.Encoding.ASCII"

Comment faire ?

Cordialement

SC

---

Cordialement SC

Answer 1

Bonjour,

Le .NET Framework n'intègre pas nativement l'encodage ANSEL. Il faudra utiliser une bibliothèque externe ou le décoder à la main...

Avez-vous regardé ce projet open source http://sourceforge.net/projects/gedcom-net/ ? Il y a une classe qui s'appelle AnselEncoding qui hérite de Encoding et qui permet de décoder des chaînes de caractères au format ANSEL.

Cordialement

---

Gilles TOURREAU - MVP C#
Architecte logiciel/Consultant/Formateur Freelance
Blog : http://gilles.tourreau.fr
- MCPD : Enterprise Developper / Windows Developper 3.5 / ASP .NET 3.5/4.0
- MCITP : SQL Server 2008 Developper
- MCTS : ADO .NET 3.5 / SQL Server 2008 Developper / Windows Forms 3.5 / ASP .NET 3.5/4.0

Answer 2

Bonjour,

Merci beaucoup

C'est bien compliqué pour moi, de plus en C, mais je vais essayer d'en tirer profit

Cordialement

SC

---

Cordialement SC

Answer 3

Bonjour M. CONSALVI,

Voici la classe traduite et rectifié de C# en VB .NET :

'
' * $Id: AnselEncoding.cs 199 2008-11-15 15:20:44Z davek $
' * 
' * AnselEncoding.cs - Based of implementation of the "System.Text.ASCIIEncoding" class in mono
' * As such this file is NOT GPL, but expat is GPL compatible so we are ok using it
' * see http://www.fsf.org/licensing/licenses/
' *
' * Copyright (c) 2001  Southern Storm Software, Pty Ltd
' * Copyright (C) 2003 Novell, Inc.
' * Copyright (C) 2004 Novell, Inc (http://www.novell.com)
' * 
' * Copyright (C) 2008 David A Knight <[e-mail]>
' *
' * Permission is hereby granted, free of charge, to any person obtaining
' * a copy of this software and associated documentation files (the "Software"),
' * to deal in the Software without restriction, including without limitation
' * the rights to use, copy, modify, merge, publish, distribute, sublicense,
' * and/or sell copies of the Software, and to permit persons to whom the
' * Software is furnished to do so, subject to the following conditions:
' *
' * The above copyright notice and this permission notice shall be included
' * in all copies or substantial portions of the Software.
' *
' * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
' * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
' * OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
' * ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
' * OTHER DEALINGS IN THE SOFTWARE.
' 


Imports System.Collections.Generic
Imports System.Text
Imports System

Namespace GedcomParser
    Public Class AnselEncoding
        Inherits Encoding
        ' Magic number used by Windows for "ANSEL" is ?
        Friend Const ANSEL_CODE_PAGE As Integer = 20127
        ' FIXME: this is ASCII not ANSEL
        ' LDS Extension empty box 
        ' LDS Extension black box 
        ' LDS Extension midline e 
        ' LDS Extension midline o 
        ' LDS Extension es zet 
        ' combiners
        Shared ReadOnly marc8 As Integer() = New Integer() {&H88, &H89, &H8D, &H8E, &HA1, &HA2, _
            &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, _
            &HA9, &HAA, &HAB, &HAC, &HAD, &HAE, _
            &HB0, &HB1, &HB2, &HB3, &HB4, &HB5, _
            &HB6, &HB7, &HB8, &HB9, &HBA, &HBC, _
            &HBD, &HBE, &HBF, &HC0, &HC1, &HC2, _
            &HC3, &HC4, &HC5, &HC6, &HC7, &HC8, _
            &HCD, &HCE, &HCF, &HE0, &HE1, &HE2, _
            &HE3, &HE4, &HE5, &HE6, &HE7, &HE8, _
            &HE9, &HEA, &HEB, &HEC, &HED, &HEE, _
            &HEF, &HF0, &HF1, &HF2, &HF3, &HF4, _
            &HF5, &HF6, &HF7, &HF8, &HF9, &HFA, _
            &HFB, &HFE}
        Const marc8CombinerStart As Integer = 45
        ' LDS Extension empty box 
        ' LDS Extension black box 
        ' LFS Extension es zet 
        ' combiners
        '0xfe20
        '0xfe22
        Shared ReadOnly ucs As Integer() = New Integer() {&H98, &H9C, &H200D, &H200C, &H141, &HD8, _
            &H110, &HDE, &HC6, &H152, &H2B9, &HB7, _
            &H266D, &HAE, &HB1, &H1A0, &H1AF, &H2BC, _
            &H2BB, &H142, &HF8, &H111, &HFE, &HE6, _
            &H153, &H2BA, &H131, &HA3, &HF0, &H1A1, _
            &H1B0, &H25AB, &H25AA, &HB0, &H2113, &H2117, _
            &HA9, &H266F, &HBF, &HA1, &HDF, &H20AC, _
            CInt(AscW(CChar("?"))), CInt(AscW(CChar("?"))), &HDF, &H309, &H300, &H301, _
            &H302, &H303, &H304, &H306, &H307, &H308, _
            &H30C, &H30A, &H361, &HFE21, &H315, &H30B, _
            &H310, &H327, &H328, &H323, &H324, &H325, _
            &H333, &H332, &H326, &H31C, &H32E, &H360, _
            &HFE23, &H313}

        Public Sub New()
            MyBase.New(ANSEL_CODE_PAGE)
        End Sub

        Public Overrides ReadOnly Property BodyName() As String
            Get
                Return "ansel"
            End Get
        End Property
        Public Overrides ReadOnly Property HeaderName() As String
            Get
                Return "ansel"
            End Get
        End Property
        Public Overrides ReadOnly Property WebName() As String
            Get
                Return "ansel"
            End Get
        End Property
        Public Overrides ReadOnly Property EncodingName() As String
            Get
                Return "ANSEL"
            End Get
        End Property
        Public Overrides ReadOnly Property IsMailNewsDisplay() As Boolean
            Get
                Return False
            End Get
        End Property
        Public Overrides ReadOnly Property IsMailNewsSave() As Boolean
            Get
                Return False
            End Get
        End Property

        Private Shared Function GetMarc8Index(c As Integer) As Integer
            Dim i As Integer = 0
            For Each marcChar As Integer In marc8
                If marcChar = c Then
                    Exit For
                End If
                i += 1
            Next
            If i = marc8.Length Then
                i = -1
            End If

            Return i
        End Function

        Private Shared Function GetUCSIndex(c As Integer) As Integer
            Dim i As Integer = 0
            For Each ucsChar As Integer In ucs
                If ucsChar = c Then
                    Exit For
                End If
                i += 1
            Next
            If i = ucs.Length Then
                i = -1
            End If

            Return i
        End Function

        Public Overrides ReadOnly Property IsSingleByte() As Boolean
            Get
                Return True
            End Get
        End Property


        Public Overrides Function GetByteCount(chars As Char(), index As Integer, count As Integer) As Integer
            If chars Is Nothing Then
                Throw New ArgumentNullException("chars")
            End If
            If index < 0 OrElse index > chars.Length Then
                Throw New ArgumentOutOfRangeException("index", "ArgRange_Array")
            End If
            If count < 0 OrElse count > (chars.Length - index) Then
                Throw New ArgumentOutOfRangeException("count", "ArgRange_Array")
            End If

            Dim c As Integer = 0

            While count > 0
                If AscW(chars(index + c)) <= &H7F Then
                    c += 1
                Else
                    Dim i As Integer = GetUCSIndex(AscW(chars(index + c)))
                    c += 1
                    If i >= marc8CombinerStart Then
                        c += 1
                    End If
                End If
                count -= 1
            End While

            Return c
        End Function

        Public Overrides Function GetByteCount(s As String) As Integer
            If s Is Nothing Then
                Throw New ArgumentNullException("s")
            End If

            Dim count As Integer = 0

            For c As Integer = 0 To s.Length - 1
                If AscW(s(c)) <= &H7F Then
                    count += 1
                Else
                    Dim i As Integer = GetUCSIndex(AscW(s(c)))
                    count += 1
                    If i >= marc8CombinerStart Then
                        count += 1
                    End If
                End If
            Next

            Return count
        End Function

        Public Overrides Function GetBytes(chars As Char(), charIndex As Integer, charCount As Integer, bytes As Byte(), byteIndex As Integer) As Integer
            If chars Is Nothing Then
                Throw New ArgumentNullException("chars")
            End If
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If charIndex < 0 OrElse charIndex > chars.Length Then
                Throw New ArgumentOutOfRangeException("charIndex", "ArgRange_Array")
            End If
            If byteIndex < 0 OrElse byteIndex > bytes.Length Then
                Throw New ArgumentOutOfRangeException("byteIndex", "ArgRange_Array")
            End If
            If (bytes.Length - byteIndex) < charCount Then
                Throw New ArgumentException("Arg_InsufficientSpace")
            End If
            Dim count As Integer = charCount
            Dim ch As Char
            While System.Math.Max(System.Threading.Interlocked.Decrement(count), count + 1) > 0
                ch = chars(System.Math.Max(System.Threading.Interlocked.Increment(charIndex), charIndex - 1))
                If ch < ChrW(&H80) Then
                    bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = CByte(AscW(ch))
                Else
                    Dim i As Integer = GetUCSIndex(AscW(ch))
                    If i <> -1 Then
                        bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = CByte(marc8(i))
                    Else
                        bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = CByte(AscW("?"c))
                    End If
                End If
            End While

            Return charCount
        End Function

        Public Overrides Function GetBytes(s As String, charIndex As Integer, charCount As Integer, bytes As Byte(), byteIndex As Integer) As Integer
            If s Is Nothing Then
                Throw New ArgumentNullException("s")
            End If
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If charIndex < 0 OrElse charIndex > s.Length Then
                Throw New ArgumentOutOfRangeException("charIndex", "ArgRange_Array")
            End If
            If byteIndex < 0 OrElse byteIndex > bytes.Length Then
                Throw New ArgumentOutOfRangeException("byteIndex", "ArgRange_Array")
            End If
            If (bytes.Length - byteIndex) < charCount Then
                Throw New ArgumentException("Arg_InsufficientSpace")
            End If
            Dim count As Integer = charCount
            Dim ch As Char
            While System.Math.Max(System.Threading.Interlocked.Decrement(count), count + 1) > 0
                ch = s(System.Math.Max(System.Threading.Interlocked.Increment(charIndex), charIndex - 1))
                If ch < ChrW(&H80) Then
                    bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = CByte(AscW(ch))
                Else
                    Dim i As Integer = GetUCSIndex(AscW(ch))
                    If i <> -1 Then
                        ' need to swap combiner position
                        If i >= marc8CombinerStart Then
                            Dim b As Byte = bytes(byteIndex - 1)
                            bytes(byteIndex - 1) = CByte(marc8(i))
                            bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = b
                        Else
                            bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = CByte(marc8(i))
                        End If
                    Else
                        bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)) = CByte(AscW("?"c))
                    End If
                End If
            End While

            Return charCount
        End Function


        Public Overrides Function GetCharCount(bytes As Byte(), index As Integer, count As Integer) As Integer
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If index < 0 OrElse index > bytes.Length Then
                Throw New ArgumentOutOfRangeException("index", "ArgRange_Array")
            End If
            If count < 0 OrElse count > (bytes.Length - index) Then
                Throw New ArgumentOutOfRangeException("count", "ArgRange_Array")
            End If

            Dim c As Integer = 0
            While count > 0
                Dim b As Byte = bytes(index + c)

                c += 1

                If b > &H7F Then
                    Dim i As Integer = GetMarc8Index(CInt(b))

                    If i >= marc8CombinerStart Then
                        c += 1
                        count -= 1
                    End If
                End If
                count -= 1
            End While
            ' possible if we have a combiner byte but nothing to combine to
            If count < 0 Then
                c -= 1
            End If

            Return c
        End Function



        Public Overrides Function GetChars(bytes As Byte(), byteIndex As Integer, byteCount As Integer, chars As Char(), charIndex As Integer) As Integer
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If chars Is Nothing Then
                Throw New ArgumentNullException("chars")
            End If
            If byteIndex < 0 OrElse byteIndex > bytes.Length Then
                Throw New ArgumentOutOfRangeException("byteIndex", "ArgRange_Array")
            End If
            If byteCount < 0 OrElse byteCount > (bytes.Length - byteIndex) Then
                Throw New ArgumentOutOfRangeException("byteCount", "ArgRange_Array")
            End If
            If charIndex < 0 OrElse charIndex > chars.Length Then
                Throw New ArgumentOutOfRangeException("charIndex", "ArgRange_Array")
            End If
            If (chars.Length - charIndex) < byteCount Then
                Throw New ArgumentException("Arg_InsufficientSpace")
            End If

            Dim count As Integer = byteCount
            Dim combine As Boolean = False
            While System.Math.Max(System.Threading.Interlocked.Decrement(count), count + 1) > 0
                Dim c As Char = ChrW(bytes(System.Math.Max(System.Threading.Interlocked.Increment(byteIndex), byteIndex - 1)))
                If c < ChrW(128) Then
                    chars(System.Math.Max(System.Threading.Interlocked.Increment(charIndex), charIndex - 1)) = c
                    If combine Then
                        charIndex += 1
                        combine = False
                    End If
                Else
                    Dim i As Integer = GetMarc8Index(AscW(c))
                    If i <> -1 Then
                        If i < marc8CombinerStart Then
                            chars(System.Math.Max(System.Threading.Interlocked.Increment(charIndex), charIndex - 1)) = ChrW(ucs(i))
                        Else
                            ' should never happen
                            If combine Then
                                charIndex += 1
                                combine = False
                            End If
                            chars(charIndex + 1) = ChrW(ucs(i))
                            combine = True
                        End If
                    Else
                        chars(System.Math.Max(System.Threading.Interlocked.Increment(charIndex), charIndex - 1)) = "?"c
                    End If
                End If
            End While

            Return byteCount
        End Function

        Public Overrides Function GetMaxCharCount(byteCount As Integer) As Integer
            If byteCount < 0 Then
                Throw New ArgumentOutOfRangeException("byteCount", "ArgRange_NonNegative")
            End If

            Return byteCount
        End Function


        Public Overrides Function GetMaxByteCount(charCount As Integer) As Integer
            If charCount < 0 Then
                Throw New ArgumentOutOfRangeException("charCount", "ArgRange_NonNegative")
            End If

            Return (charCount * 2)
        End Function

        Public Overrides Function GetString(bytes As Byte(), index As Integer, count As Integer) As String
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If index < 0 OrElse index > bytes.Length Then
                Throw New ArgumentOutOfRangeException("index", "ArgRange_Array")
            End If
            If count < 0 OrElse count > (bytes.Length - index) Then
                Throw New ArgumentOutOfRangeException("count", "ArgRange_Array")
            End If
            If count = 0 Then
                Return String.Empty
            End If
            ' probably horribly inefficient but...
            Dim chars As Char() = New Char(count - 1) {}
            GetChars(bytes, index, count, chars, 0)
            Dim s As New String(chars)

            Return s
        End Function

        Public Overrides Function GetDecoder() As Decoder
            Return MyBase.GetDecoder()
        End Function

        Public Overrides Function GetEncoder() As Encoder
            Return MyBase.GetEncoder()
        End Function

    End Class
End Namespace

Intégrez-là dans votre projet et au niveau de votre code essayez-là :

 Using Reader As New Microsoft.VisualBasic.FileIO.TextFieldParser(Me.txtFicPrincipal.Text, new AnselEncoding()) 

N'oubliez pas de nous faire un petit retour...

Cordialement

---

Gilles TOURREAU - MVP C#
Architecte logiciel/Consultant/Formateur Freelance
Blog : http://gilles.tourreau.fr
- MCPD : Enterprise Developper / Windows Developper 3.5 / ASP .NET 3.5/4.0
- MCITP : SQL Server 2008 Developper
- MCTS : ADO .NET 3.5 / SQL Server 2008 Developper / Windows Forms 3.5 / ASP .NET 3.5/4.0

Answer 4

Bonjour,

Merci pour votre amabilité

J'ai créé et installé la CLASS

Je l'utilise ainsi

Using Reader As New Microsoft.VisualBasic.FileIO.TextFieldParser(Me.txtFicPrincipal.Text, New GedcomParser.AnselEncoding())

Mais j'ai un l'incident "L'index se trouve en dehors des limites du tableau." dans la fonction :

PublicOverrides Function GetChars ….

En suivant au  débogueur, c'est dans la boucle :

WhileSystem.Math.Max….

Mais je ne sais sur qu'elle ligne, car c'est trop long à suivre …

Voici le début du fichier

0 HEAD
1 SOUR HEREDIS 11 PC
2 VERS 11
2 NAME HEREDIS PC
2 CORP BSD Concept Ã
3 ADDR www.heredis.com
1 DATE 27 SEP 2013
2 TIME 13:53:06
1 GEDC
2 VERS 5.5
2 FORM LINEAGE-LINKED
1 CHAR ANSEL
1 PLAC
2 FORM Town , Area code , County , Region , Country, Subdivision

Cordialement

SC

---

Cordialement SC

Answer 5

Bonjour,

Est-il possible que vous puissiez nous soumettre votre fichier qui pose problème (pour cela partagez sur un partage web du style Skydrive).

J'essayerai de résoudre votre problème ce week end...

Cordialement

---

Gilles TOURREAU - MVP C#
Architecte logiciel/Consultant/Formateur Freelance
Blog : http://gilles.tourreau.fr
- MCPD : Enterprise Developper / Windows Developper 3.5 / ASP .NET 3.5/4.0
- MCITP : SQL Server 2008 Developper
- MCTS : ADO .NET 3.5 / SQL Server 2008 Developper / Windows Forms 3.5 / ASP .NET 3.5/4.0

Answer 6

Merci bien !

C'est vraiment très aimable à vous !

J'ai mit un fichier de test Anomalie_PrincipaleAnsel.ged sur SkyDrive

Voici le lien (Si je n'ai pas fait de mauvaise manip ...)

Lien long

https://skydrive.live.com/redir?resid=30A159536AC0439F!106&authkey=!AJUN7EmSKhK2kt8

Lien court

http://sdrv.ms/198guXx

Bien cordialement

SC

---

Cordialement SC

Answer 7

Bonjour M. CONSALVI,

J'ai téléchargé votre fichier, j'ai crée un projet qui lit complètement le fichier et je n'ai aucune exception qui est déclenché :

    Sub Main()
        Using Reader As New Microsoft.VisualBasic.FileIO.TextFieldParser("C:\Temp\Ansel\Anomalie_PrincipaleAnsel.ged", New GedcomParser.AnselEncoding())
            Dim s As String
            s = Reader.ReadToEnd()
            Console.WriteLine(s)
        End Using

        Console.ReadLine()
    End Sub

Pouvez-vous nous confirmer que le fichier que vous avez soumis dans votre Skydrive est bien celui qui vous pose problème ? N'est ce pas un autre fichier ?
Avez vous la possibilité de nous montrer votre algo qui lit le fichier (de mon côté j'ai testé avec ReadToEnd() et des ReadLine() mais j'ai constaté aucun problème).

Cordialement

---

Gilles TOURREAU - MVP C#
Architecte logiciel/Consultant/Formateur Freelance
Blog : http://gilles.tourreau.fr
- MCPD : Enterprise Developper / Windows Developper 3.5 / ASP .NET 3.5/4.0
- MCITP : SQL Server 2008 Developper
- MCTS : ADO .NET 3.5 / SQL Server 2008 Developper / Windows Forms 3.5 / ASP .NET 3.5/4.0

Answer 8

Bonjour,

Croyez que j'apprécie vos efforts, et vous en remercie

Nous travaillons sur le même fichier

Pour plus de sécurité, j'ai téléchargé celui que j'avais mis en ligne

J'ai créé une application console, reprenant votre code, et le 0 de la première ligne est perdue !

(Ouvrez le fichier avec un éditeur, c'est 0 HEAD et non blanc HEAD)

J'ai créé un autre fichier en ANSEL, et là, c'est tout le début du fichier que je perds !!

C'est bien la classe qui est en cause, car si je ne l'utilise pas, je récupère bien toutes les lignes

Mais bien sûr, je n'ai pas les bons caractères accentués …

J'ai mis en ligne TestAnsel.ged

https://skydrive.live.com/redir?resid=30A159536AC0439F!109&authkey=!AJUN7EmSKhK2kt8

http://sdrv.ms/198guXx

Bien cordialement

SC

---

Cordialement SC

Answer 9

Bonjour M. CONSALVI,

Voici le code corrigé de la classe AnselEncoding (en espérant que cette fois-ci ca fonctionne) :

'
' * $Id: AnselEncoding.cs 199 2008-11-15 15:20:44Z davek $
' * 
' * AnselEncoding.cs - Based of implementation of the "System.Text.ASCIIEncoding" class in mono
' * As such this file is NOT GPL, but expat is GPL compatible so we are ok using it
' * see http://www.fsf.org/licensing/licenses/
' *
' * Copyright (c) 2001  Southern Storm Software, Pty Ltd
' * Copyright (C) 2003 Novell, Inc.
' * Copyright (C) 2004 Novell, Inc (http://www.novell.com)
' * 
' * Copyright (C) 2008 David A Knight <[e-mail]>
' *
' * Permission is hereby granted, free of charge, to any person obtaining
' * a copy of this software and associated documentation files (the "Software"),
' * to deal in the Software without restriction, including without limitation
' * the rights to use, copy, modify, merge, publish, distribute, sublicense,
' * and/or sell copies of the Software, and to permit persons to whom the
' * Software is furnished to do so, subject to the following conditions:
' *
' * The above copyright notice and this permission notice shall be included
' * in all copies or substantial portions of the Software.
' *
' * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
' * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
' * OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
' * ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
' * OTHER DEALINGS IN THE SOFTWARE.
' 


Imports System.Collections.Generic
Imports System.Text
Imports System

Namespace GedcomParser
    Public Class AnselEncoding
        Inherits Encoding
        ' Magic number used by Windows for "ANSEL" is ?
        Friend Const ANSEL_CODE_PAGE As Integer = 20127
        ' FIXME: this is ASCII not ANSEL
        ' LDS Extension empty box 
        ' LDS Extension black box 
        ' LDS Extension midline e 
        ' LDS Extension midline o 
        ' LDS Extension es zet 
        ' combiners
        Shared ReadOnly marc8 As Integer() = New Integer() {&H88, &H89, &H8D, &H8E, &HA1, &HA2, _
            &HA3, &HA4, &HA5, &HA6, &HA7, &HA8, _
            &HA9, &HAA, &HAB, &HAC, &HAD, &HAE, _
            &HB0, &HB1, &HB2, &HB3, &HB4, &HB5, _
            &HB6, &HB7, &HB8, &HB9, &HBA, &HBC, _
            &HBD, &HBE, &HBF, &HC0, &HC1, &HC2, _
            &HC3, &HC4, &HC5, &HC6, &HC7, &HC8, _
            &HCD, &HCE, &HCF, &HE0, &HE1, &HE2, _
            &HE3, &HE4, &HE5, &HE6, &HE7, &HE8, _
            &HE9, &HEA, &HEB, &HEC, &HED, &HEE, _
            &HEF, &HF0, &HF1, &HF2, &HF3, &HF4, _
            &HF5, &HF6, &HF7, &HF8, &HF9, &HFA, _
            &HFB, &HFE}
        Const marc8CombinerStart As Integer = 45
        ' LDS Extension empty box 
        ' LDS Extension black box 
        ' LFS Extension es zet 
        ' combiners
        '0xfe20
        '0xfe22
        Shared ReadOnly ucs As Integer() = New Integer() {&H98, &H9C, &H200D, &H200C, &H141, &HD8, _
            &H110, &HDE, &HC6, &H152, &H2B9, &HB7, _
            &H266D, &HAE, &HB1, &H1A0, &H1AF, &H2BC, _
            &H2BB, &H142, &HF8, &H111, &HFE, &HE6, _
            &H153, &H2BA, &H131, &HA3, &HF0, &H1A1, _
            &H1B0, &H25AB, &H25AA, &HB0, &H2113, &H2117, _
            &HA9, &H266F, &HBF, &HA1, &HDF, &H20AC, _
            CInt(AscW(CChar("?"))), CInt(AscW(CChar("?"))), &HDF, &H309, &H300, &H301, _
            &H302, &H303, &H304, &H306, &H307, &H308, _
            &H30C, &H30A, &H361, &HFE21, &H315, &H30B, _
            &H310, &H327, &H328, &H323, &H324, &H325, _
            &H333, &H332, &H326, &H31C, &H32E, &H360, _
            &HFE23, &H313}

        Public Sub New()
            MyBase.New(ANSEL_CODE_PAGE)
        End Sub

        Public Overrides ReadOnly Property BodyName() As String
            Get
                Return "ansel"
            End Get
        End Property
        Public Overrides ReadOnly Property HeaderName() As String
            Get
                Return "ansel"
            End Get
        End Property
        Public Overrides ReadOnly Property WebName() As String
            Get
                Return "ansel"
            End Get
        End Property
        Public Overrides ReadOnly Property EncodingName() As String
            Get
                Return "ANSEL"
            End Get
        End Property
        Public Overrides ReadOnly Property IsMailNewsDisplay() As Boolean
            Get
                Return False
            End Get
        End Property
        Public Overrides ReadOnly Property IsMailNewsSave() As Boolean
            Get
                Return False
            End Get
        End Property

        Private Shared Function GetMarc8Index(c As Integer) As Integer
            Dim i As Integer = 0
            For Each marcChar As Integer In marc8
                If marcChar = c Then
                    Exit For
                End If
                i += 1
            Next
            If i = marc8.Length Then
                i = -1
            End If

            Return i
        End Function

        Private Shared Function GetUCSIndex(c As Integer) As Integer
            Dim i As Integer = 0
            For Each ucsChar As Integer In ucs
                If ucsChar = c Then
                    Exit For
                End If
                i += 1
            Next
            If i = ucs.Length Then
                i = -1
            End If

            Return i
        End Function

        Public Overrides ReadOnly Property IsSingleByte() As Boolean
            Get
                Return True
            End Get
        End Property


        Public Overrides Function GetByteCount(chars As Char(), index As Integer, count As Integer) As Integer
            If chars Is Nothing Then
                Throw New ArgumentNullException("chars")
            End If
            If index < 0 OrElse index > chars.Length Then
                Throw New ArgumentOutOfRangeException("index", "ArgRange_Array")
            End If
            If count < 0 OrElse count > (chars.Length - index) Then
                Throw New ArgumentOutOfRangeException("count", "ArgRange_Array")
            End If

            Dim c As Integer = 0

            While count > 0
                If AscW(chars(index + c)) <= &H7F Then
                    c += 1
                Else
                    Dim i As Integer = GetUCSIndex(AscW(chars(index + c)))
                    c += 1
                    If i >= marc8CombinerStart Then
                        c += 1
                    End If
                End If
                count -= 1
            End While

            Return c
        End Function

        Public Overrides Function GetByteCount(s As String) As Integer
            If s Is Nothing Then
                Throw New ArgumentNullException("s")
            End If

            Dim count As Integer = 0

            For c As Integer = 0 To s.Length - 1
                If AscW(s(c)) <= &H7F Then
                    count += 1
                Else
                    Dim i As Integer = GetUCSIndex(AscW(s(c)))
                    count += 1
                    If i >= marc8CombinerStart Then
                        count += 1
                    End If
                End If
            Next

            Return count
        End Function

        Public Overrides Function GetBytes(chars As Char(), charIndex As Integer, charCount As Integer, bytes As Byte(), byteIndex As Integer) As Integer
            If chars Is Nothing Then
                Throw New ArgumentNullException("chars")
            End If
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If charIndex < 0 OrElse charIndex > chars.Length Then
                Throw New ArgumentOutOfRangeException("charIndex", "ArgRange_Array")
            End If
            If byteIndex < 0 OrElse byteIndex > bytes.Length Then
                Throw New ArgumentOutOfRangeException("byteIndex", "ArgRange_Array")
            End If
            If (bytes.Length - byteIndex) < charCount Then
                Throw New ArgumentException("Arg_InsufficientSpace")
            End If
            Dim count As Integer = charCount
            Dim ch As Char
            count = count - 1
            While count > 0
                ch = chars(charIndex)
                charIndex = charIndex + 1
                If ch < ChrW(&H80) Then
                    bytes(byteIndex) = CByte(AscW(ch))
                    byteIndex += 1
                Else
                    Dim i As Integer = GetUCSIndex(AscW(ch))
                    If i <> -1 Then
                        bytes(byteIndex) = CByte(marc8(i))
                    Else
                        bytes(byteIndex) = CByte(AscW("?"c))
                    End If
                    byteIndex += 1
                End If
                count = count - 1
            End While

            Return charCount
        End Function

        Public Overrides Function GetBytes(s As String, charIndex As Integer, charCount As Integer, bytes As Byte(), byteIndex As Integer) As Integer
            If s Is Nothing Then
                Throw New ArgumentNullException("s")
            End If
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If charIndex < 0 OrElse charIndex > s.Length Then
                Throw New ArgumentOutOfRangeException("charIndex", "ArgRange_Array")
            End If
            If byteIndex < 0 OrElse byteIndex > bytes.Length Then
                Throw New ArgumentOutOfRangeException("byteIndex", "ArgRange_Array")
            End If
            If (bytes.Length - byteIndex) < charCount Then
                Throw New ArgumentException("Arg_InsufficientSpace")
            End If
            Dim count As Integer = charCount
            Dim ch As Char
            count = count - 1
            While count > 0
                ch = s(charIndex)
                charIndex += 1
                If ch < ChrW(&H80) Then
                    bytes(byteIndex) = CByte(AscW(ch))
                    byteIndex += 1
                Else
                    Dim i As Integer = GetUCSIndex(AscW(ch))
                    If i <> -1 Then
                        ' need to swap combiner position
                        If i >= marc8CombinerStart Then
                            Dim b As Byte = bytes(byteIndex - 1)
                            bytes(byteIndex - 1) = CByte(marc8(i))
                            bytes(byteIndex) = b
                        Else
                            bytes(byteIndex) = CByte(marc8(i))
                        End If
                        byteIndex += 1
                    Else
                        bytes(byteIndex) = CByte(AscW("?"c))
                        byteIndex += 1
                    End If
                End If
                count = count - 1
            End While

            Return charCount
        End Function


        Public Overrides Function GetCharCount(bytes As Byte(), index As Integer, count As Integer) As Integer
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If index < 0 OrElse index > bytes.Length Then
                Throw New ArgumentOutOfRangeException("index", "ArgRange_Array")
            End If
            If count < 0 OrElse count > (bytes.Length - index) Then
                Throw New ArgumentOutOfRangeException("count", "ArgRange_Array")
            End If

            Dim c As Integer = 0
            While count > 0
                Dim b As Byte = bytes(index + c)

                c += 1

                If b > &H7F Then
                    Dim i As Integer = GetMarc8Index(CInt(b))

                    If i >= marc8CombinerStart Then
                        c += 1
                        count -= 1
                    End If
                End If
                count -= 1
            End While
            ' possible if we have a combiner byte but nothing to combine to
            If count < 0 Then
                c -= 1
            End If

            Return c
        End Function



        Public Overrides Function GetChars(bytes As Byte(), byteIndex As Integer, byteCount As Integer, chars As Char(), charIndex As Integer) As Integer
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If chars Is Nothing Then
                Throw New ArgumentNullException("chars")
            End If
            If byteIndex < 0 OrElse byteIndex > bytes.Length Then
                Throw New ArgumentOutOfRangeException("byteIndex", "ArgRange_Array")
            End If
            If byteCount < 0 OrElse byteCount > (bytes.Length - byteIndex) Then
                Throw New ArgumentOutOfRangeException("byteCount", "ArgRange_Array")
            End If
            If charIndex < 0 OrElse charIndex > chars.Length Then
                Throw New ArgumentOutOfRangeException("charIndex", "ArgRange_Array")
            End If
            If (chars.Length - charIndex) < byteCount Then
                Throw New ArgumentException("Arg_InsufficientSpace")
            End If

            Dim count As Integer = byteCount
            Dim combine As Boolean = False
            count -= 1
            While count > 0
                byteIndex += 1
                Dim c As Char = ChrW(bytes(byteIndex - 1))
                If c < ChrW(128) Then
                    chars(charIndex) = c
                    charIndex += 1
                    If combine Then
                        charIndex += 1
                        combine = False
                    End If
                Else
                    Dim i As Integer = GetMarc8Index(AscW(c))
                    If i <> -1 Then
                        If i < marc8CombinerStart Then
                            chars(charIndex) = ChrW(ucs(i))
                            charIndex += 1
                        Else
                            ' should never happen
                            If combine Then
                                charIndex += 1
                                combine = False
                            End If
                            chars(charIndex + 1) = ChrW(ucs(i))
                            combine = True
                        End If
                    Else
                        chars(charIndex) = "?"c
                        charIndex += 1
                    End If
                End If
                count -= 1
            End While

            Return byteCount
        End Function

        Public Overrides Function GetMaxCharCount(byteCount As Integer) As Integer
            If byteCount < 0 Then
                Throw New ArgumentOutOfRangeException("byteCount", "ArgRange_NonNegative")
            End If

            Return byteCount
        End Function


        Public Overrides Function GetMaxByteCount(charCount As Integer) As Integer
            If charCount < 0 Then
                Throw New ArgumentOutOfRangeException("charCount", "ArgRange_NonNegative")
            End If

            Return (charCount * 2)
        End Function

        Public Overrides Function GetString(bytes As Byte(), index As Integer, count As Integer) As String
            If bytes Is Nothing Then
                Throw New ArgumentNullException("bytes")
            End If
            If index < 0 OrElse index > bytes.Length Then
                Throw New ArgumentOutOfRangeException("index", "ArgRange_Array")
            End If
            If count < 0 OrElse count > (bytes.Length - index) Then
                Throw New ArgumentOutOfRangeException("count", "ArgRange_Array")
            End If
            If count = 0 Then
                Return String.Empty
            End If
            ' probably horribly inefficient but...
            Dim chars As Char() = New Char(count - 1) {}
            GetChars(bytes, index, count, chars, 0)
            Dim s As New String(chars)

            Return s
        End Function

        Public Overrides Function GetDecoder() As Decoder
            Return MyBase.GetDecoder()
        End Function

        Public Overrides Function GetEncoder() As Encoder
            Return MyBase.GetEncoder()
        End Function

    End Class
End Namespace

Cordialement

---

Gilles TOURREAU - MVP C#
Architecte logiciel/Consultant/Formateur Freelance
Blog : http://gilles.tourreau.fr
- MCPD : Enterprise Developper / Windows Developper 3.5 / ASP .NET 3.5/4.0
- MCITP : SQL Server 2008 Developper
- MCTS : ADO .NET 3.5 / SQL Server 2008 Developper / Windows Forms 3.5 / ASP .NET 3.5/4.0

Answer 10

Bonjour,

Bingo !

Encore un grand merci !

Très cordialement

SC

---

Cordialement SC