Crypter le contenu d'un .txt et l'utiliser dans VB

Résolu
danielgrd Messages postés 47 Date d'inscription mercredi 15 janvier 2003 Statut Membre Dernière intervention 22 juin 2005 - 27 déc. 2004 à 19:58
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 28 déc. 2004 à 14:43
À partir d'un de ces deux codes (ils effectuent la même opération) provenant de ce topic :
http://www.vbfrance.com/forum.v2.aspx?ID=357484&post=ok

Est-il possible de pouvoir crypter le contenu du fichier "d.txt" et de le lire quand même...

N'importe quel cryptage.... D'abord que le contenue de d.txt est illisible... Seulement camoufler le contenu... Sécuritaire ou pas...

IMPORTANT : Le Fichier Doit Paraître Crypter Même Pendant Sa Lecture!!! Si c'est possible!

Merci d'avance

---------------------------------------------------------------------------------
Le fichier "d.txt" contiendrait ceci par exemple...

mot1#mot2#mot3#mot4#mot5
mot6#mot7#mot8#mot9#mot10
mot11#mot12#mot13#mot14#mot15
mot16#mot17#mot18#mot20#mot21
etc...
--------------------------------------------------------------------------------

Les 2 codes qui permettent de lire chacun des mots séparémment :

-------------------------------------------------------------------------------
Option Explicit
Option Base 0
Dim Table() As String

Private Sub Form_Load()
Dim Texte As String
Dim Lignes() As String
Dim Mots() As String
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer

Open "c:\d.txt" For Binary As #1
Texte = Space$(LOF(1))
Get #1, , Texte
Close #1
Lignes = Split(Texte, vbCrLf)x UBound(Lignes): y 1
ReDim Table(x, y)
For i = 0 To x - 1
Mots = Split(Lignes(i), "#")
If UBound(Mots) > y Then
y = UBound(Mots)
ReDim Preserve Table(x, y)
End If
For j = 0 To UBound(Mots) - 1
Table(i + 1, j + 1) = Mots(j)
Next
Next
End Sub

Exemple d'utilisation :

MsgBox Table (1,1) 'lire le 1er mot de la 1ere ligne
MsgBox Table (4,9) 'lire le 9e mot de la 4e ligne

------------------------------------------------------------------------------------
ou
------------------------------------------------------------------------------------
Function GiveMots(aPathFile As String, aLine As Integer, aPos As Integer) As String
Dim fso As New FileSystemObject
Dim myTxt As TextStream ' le fichier text contenant les lignes de mots
Dim myLine As String ' la ligne
Dim myTabLine() As String ' le tableau resulat de la decoupe de la ligne

' ouverture du fichier texte passé en parametre
Set myTxt = fso.OpenTextFile(aPathFile, ForReading)

' on boucle jusque l'on arrive a la hauteur de la ligne
' on s 'arrete a la ligne precedente , cela explique aline - 1
For i = 1 To aLine - 1
' si on est arrivé a a la fin du fichier
If myTxt.AtEndOfStream = True Then
' il n' a pas autant de lignes ....
GiveMots = "!#ERROR#!"
Exit For

Else
myTxt.SkipLine
End If
Next i

If GiveMots = "" Then
' a ce niveau on est positionné sur la ligne recherher "aLine"
' On la recupere dans la variable myLine
myLine = myTxt.ReadLine

' on la decoupe en fonction #
myTabLine = Split(myLine, "#")

'A ce niveau on a recuperé un tableau contenant tous les mots de la ligne recherchées

' si la position existe ... aPos - 1 car le tableau commence a
' l 'indice zero ... Ubound = plus grand indice du tableau
If UBound(myTabLine) > aPos - 1 Then
' return du mots a la position demande ..
GiveMots = myTabLine(aPos - 1)
Else
' sinon il n' y as pas de mots a cette position
GiveMots = "!#ERROR#!"
End If
End If
End Function

Exemple d'utilsation :

Dim monMots As String

monMots = GiveMots(App.Path & "\d.txt",2, 4)
'lire 4e mot de la 2e ligne

MsgBox monMots

-------------------------------------------------------------------------------------
A voir également:

4 réponses

Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 34
27 déc. 2004 à 21:20
attention dans le deuxième programme, si tu as 50 Labels, le fichiers est lu 50 fois, et fso n'est pas réputé très rapide.

petit programme de cryptage:

[Code]
Dim i As Integer
Dim t As Long
Dim Lg As Long
Dim Buffer() As Byte

Open "C:\b.txt" For Binary As #1
Lg = LOF(1) - 1
ReDim Buffer(Lg)
Get #1, , Buffer
Close #1

t = Timer
Rnd -1
Randomize t
For i = 0 To Lg
Buffer(i) = Buffer(i) Xor Rnd * 255
Next
Open "C:\d.txt" For Binary As #2
Put #2, , t
Put #2, , Buffer
Close #2
[Code]

Daniel
3
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 34
28 déc. 2004 à 14:43
pas de problèmes il était fait, mais vu ton post suivant je pensais que tu voulais quelque chose de plus compliqué. celui ci est très simple, il n'y a pas de clé, il est basé sur les nombres aléatoires, pour retrouver la même séquence de nombres il faut partir de la même base, le programme précédent a pris le Timer pour base et celui ci est écris dans le fichier (4 premiers caractères) à partir de là il suffit de faire Rnd -1 (réinitialisation) et Randomize t (même base de départ).
en sortir on retrouve le fichier complet et en clair dans Texte.

    Dim i        As Integer
    Dim t        As Long
    Dim Lg       As Long
    Dim Buffer() As Byte
    Dim Texte    As String

    Open "C:\d.txt" For Binary As #1
    Lg = LOF(1) - 5
    ReDim Buffer(Lg)
    Get #1, , t
    Get #1, , Buffer
    Close #1
    
    Rnd -1
    Randomize t
    For i = 0 To Lg
        Texte = Texte & Chr$(Buffer(i) Xor Rnd * 255)
        Next


Daniel
3
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 34
27 déc. 2004 à 21:22
le programme pour décrypter est en cours de construction.

Daniel
0
danielgrd Messages postés 47 Date d'inscription mercredi 15 janvier 2003 Statut Membre Dernière intervention 22 juin 2005
28 déc. 2004 à 14:30
Bonjour,

Je te remerci beaucoup pour le crypteur... Il fonctionne très bien... Mais sans le décrypteur il me sera difficile de réutiliser mon fichier!!!!! Peut-être es-tu en train de le construire? Dans ce cas, pas de problème, j'attend...!!!

Merci d'avance...
0
Rejoignez-nous