Un problème avec GetPrivateProfileString

Résolu
Signaler
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
-
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
-
Bonjour,
Je crée actuellement une class servant à géré différent type connection à des bases de données. Cette class dois également pouvoir sauvegarder ses paramétrés dans des fichiers .ini  (jusque là rien de bien complexe).

Sauf que pour certain paramétré je veut sauvegarder des chaînes crypté (login password, oui je sait qu'un ini n'est pas fait pour ça mais bon). Etant données l'algo de cryptage que j'utilise il risque d'apparaître des carac 0 ou encore des retours chariots (en faite tout en n'importe quel caractère).

Du coup pour lire et écrire mon ini je fait ça :
<hr size="2" width="100%" />Private Sub
CCIni_
Ecrire(ByRef stSection As String, ByRef stKey As String, ByVal stValeur As String, ByRef stFichier As String)
    stValeur = Replace(stValeur, Chr(1), Chr(1) & "C1" & Chr(1))
    stValeur = Replace(stValeur, Chr(0), Chr(1) & "C0" & Chr(1))
    stValeur = Replace(stValeur, vbCrLf, Chr(1) & "CL" & Chr(1))
    stValeur = Replace(stValeur, vbCr, Chr(1) & "C" & Chr(1))
    stValeur = Replace(stValeur, vbLf, Chr(1) & "L" & Chr(1))
    WritePrivateProfileString stSection, stKey, stValeur, stFichier
End Sub

Private Sub
CCIni_
Lire(ByRef stSection As String, ByRef stKey As String, ByRef stValeur As String, ByRef stFichier As String)
    Dim stBuf As String
    Dim lgBuf, lgRep As Integer
    ' Mise en place du buffer de lecture
    stBuf = Space(51200) 'Un peut gros mais comme ça je suis tranquille
    lgBuf = 51200
    lgRep = GetPrivateProfileString(stSection, stKey, "", stBuf, lgBuf, stFichier)
    stValeur = Left(stBuf, lgRep)
    stValeur = Replace(stValeur, Chr(1) & "C1" & Chr(1), Chr(1))
    stValeur = Replace(stValeur, Chr(1) & "C0" & Chr(1), Chr(0))
    stValeur = Replace(stValeur, Chr(1) & "CL" & Chr(1), vbCrLf)
    stValeur = Replace(stValeur, Chr(1) & "C" & Chr(1), vbCr)
    stValeur = Replace(stValeur, Chr(1) & "L" & Chr(1), vbLf)
End Sub

'CC pour chaîne crypté

<hr size="2" width="100%" />
Et tout fonctionnais bien jusqu'à un test de ce matin :
 Un carac 3 commence ma chaîne, et il n'est pas lut (WritePrivateProfileString l'écrit mais GetPrivateProfileString ne le lit pas) !!! Forcément ma chaîne ne peut jamais être décrypté correctement.

Ma question :

Connaîtriez vous la liste précise des limitations de GetPrivateProfileString et/ou WritePrivateProfileString. J'ai beau cherché je ne rien de concluant, déjà je n'es rien trouvé sur mon problème de caractère (serai je le 1ér  ?) ???

Merci

Ma solution temporaire :
J'ajoute un caractère au début de ma chaîne (en l'occurrence "C" pour crypté) pour éviter ce problème (il semble que ce bug n'apparais que lorsque le 1ér caractère est un caractère de contrôle mais je ne les es pas tous tester).

PS :
Même problème avec le carac 1 (pas d'autre test de fait)

Amicalement
Pensez "Réponse acceptée"

12 réponses

Messages postés
17288
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
71
c'est normal, ca fait partie des specifications de la base 64
les données sont coupées par lignes de longueur donnée...

les sauts de lignes sont ignorés... supprime les... elles sont là pour raison historique

Private Sub Form_Load()
Dim a() As Byte
Dim b As String
   a = "je fais des tests avec une chaine !"
   b = Replace(Base64Enc(a), vbCrLf, vbNullString)
   MsgBox Base64Dec(b)
End Sub<hr />
Public Function Base64Enc(ByRef vxbData() As Byte) As String
   With CreateObject("MSXML.DOMDocument").createElement("Base64")
       .dataType = "bin.base64"
       .nodeTypedValue = vxbData
       Base64Enc = .Text
   End With
End Function<hr />
Public Function Base64Dec(ByRef vsData As String) As Byte()
   With CreateObject("MSXML.DOMDocument").createElement("Base64")
       .dataType = "bin.base64"
       .Text = vsData
       Base64Dec = .nodeTypedValue
   End With
End Function , ----
By Renfield

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Renfield : (Je viens d'avoir une idée pour modif mon code j'en profite)
Oui je sait que c'est précisé à ce niveau mais la confusion est souvent faite (c'est pas pour ce que ça coûte de l'ajouté )
(PS : Ça m'a beaucoup perturbe de voir que cette fonction me retournais des CrLf j'ai l'habitude que les code trouvé sur Codyx fonctionne sans problème. Merci encore de l'info j'allais me mettre à re-vérifié en détail tout ce que je récup. Je vérif quand même mais rarement dans le détail)

Dernière petite modif à mes fonction de codage/décodage (Hé 59% plus rapide que la 1.0 pour le codage quand même, au prix de 130 oct de mémoire, 65 codage 65 décodage, autant dire presque rien ) + message d'erreur plus précis (en cas d'erreur ) dans la fonction de décodage.
<hr size="2" width="100%" />'Constante d'erreur de la fonction Decode_BaseText
Private Const CErr_Decode_BaseText_Message = "Une erreur est survenue dans la fonction Decode_'BaseText'. Cette erreur est sans doute dû à un problème de format de la chaîne d'entrée."

'--------------------------------------------------------------------------------------------------------------------
'Description :
'   Encode en base text la chaîne de caractère passé en paramètre (inverse de Decode_BaseText)
'Input :
'   ChaineACoder : Chaîne de caractère à encoder
'Output :
'   string : Chaîne de caractère encodé en BaseText
'Version 1.1
'Dernière modif :
'   Optimisation (au détriment de 65 oct de mémoire)
'Développé par Waurzyczka Vincent (Polack77)
'Date : 21/02/2008
'--------------------------------------------------------------------------------------------------------------------
Public Function Encode_BaseText(ByVal ChaineACoder As String) As String
Static BaseTextChaine As String
Dim BaseTextSeparateur As String
Dim ChaineCoder As String
Dim Compteur As Long
Dim Part As Byte
Dim Carac As Byte
    BaseTextSeparateur = Chr(126)
    If BaseTextChaine = vbNullString Then
        For Compteur = 33 To 98
            BaseTextChaine = BaseTextChaine & Chr(Compteur)
        Next
    End If
    Part = 2
    For Compteur = 1 To Len(ChaineACoder)
        Carac = Asc(Mid(ChaineACoder, Compteur, 1))
        Select Case True
            Case Part = 1 And Carac < 32:
                ChaineCoder = ChaineCoder & Mid(BaseTextChaine, Carac, 1)
            Case Part = 3 And Carac > 125 And Carac <= 190:
                ChaineCoder = ChaineCoder & Mid(BaseTextChaine, Carac - 125, 1)
            Case Part = 4 And Carac > 190:
                ChaineCoder = ChaineCoder & Mid(BaseTextChaine, Carac - 190, 1)
            Case Part = 2 And Carac >= 32 And Carac <= 125:
                ChaineCoder = ChaineCoder & Chr(Carac) 'Si Mid(ChaineACoder, Compteur, 1) plus rapide remplacé
            Case Else
                If Carac < 32 Then
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "1" & Mid(BaseTextChaine, Carac + 1, 1)
                    Part = 1
                ElseIf Carac > 125 And Carac <= 190 Then
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "3" & Mid(BaseTextChaine, Carac - 125, 1)
                    Part = 3
                ElseIf Carac > 190 Then
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "4" & Mid(BaseTextChaine, Carac - 190, 1)
                    Part = 4
                Else
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "2" & Chr(Carac)
                    Part = 2
                End If
        End Select
    Next
    Encode_BaseText = ChaineCoder
End Function

'--------------------------------------------------------------------------------------------------------------------
'Description :
'   Décode la chaîne de caractère passé en paramètre (inverse de Encode_BaseText)
'Input :
'   ChaineADecoder : Chaîne de caractère à décoder
'Output :
'   string : Chaîne de caractère décodé
'Version 1.1
'Dernière modif :
'   Ajout de la gestion d'erreur
'   Optimisation (au détriment de 65 oct de mémoire)
'Développé par Waurzyczka Vincent (Polack77)
'Date : 22/02/2008
'--------------------------------------------------------------------------------------------------------------------
Public Function Decode_BaseText(ByVal ChaineADecoder As String) As String
Static BaseTextChaine As String
Dim BaseTextSeparateur As String
Dim ChaineDecoder As String
Dim Carac As String
Dim Compteur As Long
Dim Part As Byte
Dim FlagChangPart As Boolean
On Error GoTo ErreurDecode_BaseText
    BaseTextSeparateur = Chr(126)
    If BaseTextChaine = vbNullString Then
        For Compteur = 33 To 98
            BaseTextChaine = BaseTextChaine & Chr(Compteur)
        Next
    End If
    Part = 2
    For Compteur = 1 To Len(ChaineADecoder)
        If FlagChangPart Then
            Part = CByte(Mid(ChaineADecoder, Compteur, 1))
            FlagChangPart = False
        Else
            Carac = Mid(ChaineADecoder, Compteur, 1)
            If Carac = BaseTextSeparateur Then
                FlagChangPart = True
            Else
                Select Case Part
                    Case 1:
                        ChaineDecoder = ChaineDecoder & Chr(InStr(1, BaseTextChaine, Carac) - 1)
                    Case 2:
                        ChaineDecoder = ChaineDecoder & Carac
                    Case 3:
                        ChaineDecoder = ChaineDecoder & Chr(InStr(1, BaseTextChaine, Carac) + 125)
                    Case 4:
                        ChaineDecoder = ChaineDecoder & Chr(InStr(1, BaseTextChaine, Carac) + 190)
                End Select
            End If
        End If
    Next
    Decode_BaseText = ChaineDecoder
Exit Function
ErreurDecode_BaseText:
    Err.Raise Err.Number, Err.Source & " (Function Decode_BaseText)", CErr_Decode_BaseText_Message & vbCrLf & Err.Description
End Function

Public Sub test()
Dim t As Date
Dim cpt As Long
    t = Now()
    For cpt = 0 To 500000
        'Encode_BaseText "toto" & Chr(0) & Chr(125) & Chr(126) & Chr(190) & Chr(191) & Chr(255) & "tata" '23 sec
        'Encode64 "toto" & Chr(0) & Chr(125) & Chr(126) & Chr(190) & Chr(191) & Chr(255) & "tata" '21 sec
       
        'Encode_BaseText "toto tata" '10 sec
        'Encode64 "toto tata" '12 sec
    Next
    MsgBox DateDiff("s", t, Now())
End Sub

<hr size="2" width="100%" />Par curiosité j'ai comparer en terme de temps d'exécution mes fonction et celle de Codyx (en espérant être BEAUCOUP plus rapide... Déception elle sont ~ équivalente , sauf si on doit retirer les CrLf ??? pas vérif, les temps d'exec chez moi sont noté en commentaire dans la fonction test, moi j'utiliserais mes fonction quand même... Na ! J'ai pas fait ça pour rien! Temps pi pour les normes , de toute façon du criptage dans de l'ini c'est déjà pas vraiment classique )

Aller maintenant c'est bon je ne toucherais sans doute pas à ces fonctions avant LONGTEMPS (et profité de mon arrêt maladie pour me reposé peut être )

Amicalement
Pensez "Réponse acceptée"
Messages postés
14828
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
18 novembre 2021
157
Bonjour

Tu pourrais utiliser la Base 64, ou encore l'affichage en Hexadécimal, comme cela, tu peut connaitre la valeur des octets sans risquer d'utiliser des caractères mal interprétés par les APIs.

Dans Word, j'Excel. (juste pour la citation)
VB (6, .NET1&2), C++, C#.Net1
Mon site
Messages postés
17288
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
71
le format base64 me semble en effet bien adapté...

plus de Replace etc... tu pourras stocker TOUT ce que tu souhaites dans un simple fichier INI

http://www.codyx.org/snippet_chaine-vers-base-64-vice-versa_62.aspx#1651
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Quel réactivité Hoooooooo
MERCI



Merci de l'info  mais... heee... base 64 ça marche comment au faite (j'ai regardé le lient que Renfield à donné et j'avoue que j'y comprend pas grand chose en faite) ?

NHenry (hooo toi grand manitou qui résout tout les problèmes que je poste sur ce site , Merci). Que veut tu dire par "affichage en Hexadécimal" utilisé les méthode Put et Get ?

Amicalement
Pensez "Réponse acceptée"
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Pardon j'ai répondu un peut vite pour base 64

Je viens de tester et il me semble qe c'est un code pour codé/décodé une chaine de caractère en une chaîne ne contenant que des caractères de standard. Pas mal merci du tuyau (même le test que j'ai fait avec le caractère 0  fonctionne, en plus il est plus que particulier celui là.....)
Mon piti test (fait avec le code trouvé sur le lient de Renfield)
<hr size="2" width="100%" />Public Sub Test()
Dim ChTest As String
Dim Temp As String
    ChTest = Chr(1) & Chr(255) & "toto" & Chr(0) & "tata"
    Temp = Encode64(ChTest)
    MsgBox Temp
    Temp = Decode64(Temp)
    If Temp = ChTest Then
        MsgBox "Ok"
    Else
        MsgBox "Erreur"
    End If
End Sub

<hr size="2" width="100%" />
Amicalement
Pensez "Réponse acceptée"
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Décidément j'oublie plein de truc ce soir...
Ma solution :
<hr size="2" width="100%" />Private Sub
CCIni_
Ecrire(ByRef stSection As String, ByRef stKey As String, ByVal stValeur As String, ByRef stFichier As String)
    stValeur = Encode64(stValeur)
    WritePrivateProfileString stSection, stKey, stValeur, stFichier
End Sub

Private Sub
CCIni_
Lire(ByRef stSection As String, ByRef stKey As String, ByRef stValeur As String, ByRef stFichier As String)
    Dim stBuf As String
    Dim lgBuf, lgRep As Integer
    ' Mise en place du buffer de lecture
    stBuf = Space(51200) 'Un peut gros mais comme ça je suis tranquille
    lgBuf = 51200
    lgRep = GetPrivateProfileString(stSection, stKey, "", stBuf, lgBuf, stFichier)
    stValeur = Left(stBuf, lgRep)
    stValeur = Decode64(stValeur)
End Sub

'CC pour chaîne crypté
<hr size="2" width="100%" />MERCI encore de la réactivité

Amicalement
Pensez "Réponse acceptée"
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Haaaaaaa mais, mais non, mais que se qui se passe ??????

Base64 ça ne fonctionne pas (ou ça viens du lient donnée par Renfield) !!!!!!
Encode64("je fait des test avec une chai") 'Oui je sait l'orthographe n'est pas bonne
Me retourne une chaîne avec un CrLf !!!!

Pour en être convaincu il suffit de faire :
MsgBox InStr(1, Encode64("je fait des test avec une chai"), vbCrLf)
Moi je sait : 41

Je repasse sur ma solution temporaire

Merci quand même l'idée de convertir toute la chaîne en chaîne ne contenant que des caractères standard est bonne (plus même, je vais sans doute creusé quelque temps dans ce sens)

Amicalement
Pensez "Réponse acceptée"
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Bon je viens de finir les testes de mes fonction BaseText (je les posterais sans doute dans codix si vous voulez faite le, mais ne touché pas aux entêtes de fonction ). Elle n'ont pas pour but de crypté les données.

MES fonction BaseText

<hr size="2" width="100%" />'--------------------------------------------------------------------------------------------------------------------
'Description :
'   Encode en base text la chaîne de caractère passé en paramètre (inverse de Decode_BaseText)
'Input :
'   ChaineACoder : Chaîne de caractère à encoder
'Output :
'   string : Chaîne de caractère encodé en BaseText
'Version 1.0
'Développé par Waurzyczka Vincent (Polack77)
'Date : 21/02/2008
'--------------------------------------------------------------------------------------------------------------------
Public Function Encode_BaseText(ByVal ChaineACoder As String) As String
Dim BaseTextChaine As String
Dim BaseTextSeparateur As String
Dim ChaineCoder As String
Dim Compteur As Long
Dim Part As Byte
Dim Carac As Byte
    BaseTextSeparateur = Chr(126)
    For Compteur = 33 To 125
        BaseTextChaine = BaseTextChaine & Chr(Compteur)
    Next
    Part = 2
    For Compteur = 1 To Len(ChaineACoder)
        Carac = Asc(Mid(ChaineACoder, Compteur, 1))
        Select Case True
            Case Part = 1 And Carac < 32:
                ChaineCoder = ChaineCoder & Mid(BaseTextChaine, Carac, 1)
            Case Part = 3 And Carac > 125 And Carac <= 190:
                ChaineCoder = ChaineCoder & Mid(BaseTextChaine, Carac - 125, 1)
            Case Part = 4 And Carac > 190:
                ChaineCoder = ChaineCoder & Mid(BaseTextChaine, Carac - 190, 1)
            Case Part = 2 And Carac >= 32 And Carac <= 125:
                ChaineCoder = ChaineCoder & Chr(Carac) 'Si Mid(ChaineACoder, Compteur, 1) plus rapide remplacé
            Case Else
                If Carac < 32 Then
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "1" & Mid(BaseTextChaine, Carac + 1, 1)
                    Part = 1
                ElseIf Carac > 125 And Carac <= 190 Then
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "3" & Mid(BaseTextChaine, Carac - 125, 1)
                    Part = 3
                ElseIf Carac > 190 Then
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "4" & Mid(BaseTextChaine, Carac - 190, 1)
                    Part = 4
                Else
                    ChaineCoder = ChaineCoder & BaseTextSeparateur & "2" & Chr(Carac)
                    Part = 2
                End If
        End Select
    Next
    Encode_BaseText = ChaineCoder
End Function

'--------------------------------------------------------------------------------------------------------------------
'Description :
'   Décode la chaîne de caractère passé en paramètre (inverse de Encode_BaseText)
'Input :
'   ChaineADecoder : Chaîne de caractère à décoder
'Output :
'   string : Chaîne de caractère décodé
'Version 1.0
'Développé par Waurzyczka Vincent
(Polack77)

'Date : 21/02/2008
'--------------------------------------------------------------------------------------------------------------------
Public Function Decode_BaseText(ByVal ChaineADecoder As String) As String
Dim BaseTextChaine As String
Dim BaseTextSeparateur As String
Dim ChaineDecoder As String
Dim Carac As String
Dim Compteur As Long
Dim Part As Byte
Dim FlagChangPart As Boolean
    BaseTextSeparateur = Chr(126)
    For Compteur = 33 To 125
        BaseTextChaine = BaseTextChaine & Chr(Compteur)
    Next
    Part = 2
    For Compteur = 1 To Len(ChaineADecoder)
        If FlagChangPart Then
            Part = CByte(Mid(ChaineADecoder, Compteur, 1))
            FlagChangPart = False
        Else
            Carac = Mid(ChaineADecoder, Compteur, 1)
            If Carac = BaseTextSeparateur Then
                FlagChangPart = True
            Else
                Select Case Part
                    Case 1:
                        ChaineDecoder = ChaineDecoder & Chr(InStr(1, BaseTextChaine, Carac) - 1)
                    Case 2:
                        ChaineDecoder = ChaineDecoder & Carac
                    Case 3:
                        ChaineDecoder = ChaineDecoder & Chr(InStr(1, BaseTextChaine, Carac) + 125)
                    Case 4:
                        ChaineDecoder = ChaineDecoder & Chr(InStr(1, BaseTextChaine, Carac) + 190)
                End Select
            End If
        End If
    Next
    Decode_BaseText = ChaineDecoder
End Function

<hr size="2" width="100%" />Remarque : La zone 2 à été volontairement étendu pour que les chaîne de caractère 'classique' ne soit pas allongé (le carac '~' 126, utilisé comme séparateur, étant relativement rare)

Le fait que les fonctions Encode64
Decode64
fournis sur le liens de Renfield ne fonctionne pas (à moins
que les caractère CrLf fasse partie de la Base64 mais il ne me semble pas : ici)
mais bon le fait est là :

MsgBox InStr(1, Encode64("je fait des test avec une chai"), vbCrLf)

Merci pour l'idée

Amicalement
Pensez "Réponse acceptée"
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
lol
Ok merci Renfield (bon bà je me suis fais chier pour rien... Bà ça c'est fait)
Amicalement
Pensez "Réponse acceptée"
Messages postés
1098
Date d'inscription
mercredi 22 mars 2006
Statut
Membre
Dernière intervention
22 octobre 2019
1
Heee juste une remarque : c'est du VB6 (je penserais à le précisé dans l'entête de message la prochaine fois )

Amicalement
Pensez "Réponse acceptée"
Messages postés
17288
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
71
précisé ici:
Vous êtes ici : Thèmes / Visual Basic 6 /

donc ca roule

Renfield
Admin CodeS-SourceS- MVP Visual Basic