none
(Visual Studio 2008) Lire un fichier ANSEL RRS feed

  • 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

    jeudi 26 septembre 2013 18:16

Réponses

  • 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

    jeudi 26 septembre 2013 21:12
    Modérateur
  • 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 <david@ritter.demon.co.uk>
    ' *
    ' * 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

    lundi 30 septembre 2013 22:33
    Modérateur

Toutes les réponses

  • 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

    jeudi 26 septembre 2013 21:12
    Modérateur
  • 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

    vendredi 27 septembre 2013 07:57
  • 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 <david@ritter.demon.co.uk>
    ' *
    ' * 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

    vendredi 27 septembre 2013 11:09
    Modérateur
  • 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

    vendredi 27 septembre 2013 12:30
  • 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

    vendredi 27 septembre 2013 13:23
    Modérateur
  • 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

    vendredi 27 septembre 2013 14:40
  • 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

    dimanche 29 septembre 2013 23:44
    Modérateur
  • 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

    lundi 30 septembre 2013 08:50
  • 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 <david@ritter.demon.co.uk>
    ' *
    ' * 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

    lundi 30 septembre 2013 22:33
    Modérateur
  • Bonjour,

    Bingo !

    Encore un grand merci !

    Très cordialement

    SC


    Cordialement SC

    mardi 1 octobre 2013 04:26