Un problème avec GetPrivateProfileStringRésolu

Question

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 :

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é

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"

Renfield · Accepted Answer

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

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

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

NHenry · Answer

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

Renfield · Answer

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

Polack77 · Answer

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"

Polack77 · Answer

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)

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

Amicalement Pensez "Réponse acceptée"

Polack77 · Answer

Décidément j'oublie plein de truc ce soir... Ma solution :

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é

MERCI encore de la réactivité Amicalement Pensez "Réponse acceptée"

Polack77 · Answer

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"

Polack77 · Answer

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

'-------------------------------------------------------------------------------------------------------------------- '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

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"

Polack77 · Answer

lol
Ok merci Renfield (bon bà je me suis fais chier pour rien... Bà ça c'est fait)
Amicalement 
Pensez "Réponse acceptée"

Polack77 · Answer

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"

Renfield · Answer

précisé ici:
 Vous êtes ici : Thèmes / Visual Basic 6 /

donc ca roule

Renfield
Admin CodeS-SourceS- MVP Visual Basic

Polack77 · Answer

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.

'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

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"

Un problème avec GetPrivateProfileString

12 réponses

Votre réponse

Discussions similaires