Cryptage de phrase dans un dessin bmp

Commenter

Contenu du snippet

Ce programme met à la fin d'une bmp un texte saisie, qui n'apparait pas sur le dessin.
(Protection de données).

Source / Exemple : 


'
' CRYPTAGE d'un message dans un dessin BMP
' TESTER EN VBA gerard vient (FRANCE)
' Creer un écran avec :
'      - une zone de saisie pour le texte à coder
'      - une zone  de saisie pour le nom du fichier BMP servant de base au codage
'      - un bouton pour crypter
'      - un bouton pour decrypter
'      - Une zone image pour afficher le dessin d'origine
'      - une zone image pour afficher le resultat avec le texte crypter
'
VERSION 5.00
Begin UserForm1 
   Caption         =   "UserForm1"
   ClientHeight    =   4620
   ClientLeft      =   45
   ClientTop       =   285
   ClientWidth     =   8670
   OleObjectBlob   =   "UserForm1.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "UserForm1"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
'
' on met le texte à la fin du dessin
'
Dim dessin As String, zone As String
Open TextBox2.Text For Binary As 1
longueur = LOF(1)
dessin = String(longueur, "x")
Get #1, 1, dessin
'
' resultat zone de saisie + longeur sur 10 caracteres
'
zone = TextBox1.Text + Right("0000000000" + Mid(Str(Len(TextBox1.Text)), 2), 10)
dessin = Left$(dessin, Len(dessin) - Len(zone)) + zone
Close #1
'
' le resultat est mis dans le fichier bitmap resultat.bmp
'
Open "resultat.bmp" For Binary As 1
Put #1, 1, dessin
Close #1
Image2.Picture = LoadPicture("resultat.bmp")
End Sub

Private Sub CommandButton2_Click()
Dim dessin As String
'
' lecture du fichier code
'
Open "resultat.bmp" For Binary As 1
longueur = LOF(1)
dessin = String(longueur, "x")
Get #1, 1, dessin
Close #1
'
' on extrait la longueur du texte
'
longtexte = Val(Right$(dessin, 10))
'
' et on le prend dans les donnees
'
If longtexte > 0 Then
   TextBox1.Text = Mid$(dessin, Len(dessin) - longtexte - 9, longtexte)
End If
End Sub

Private Sub Image1_Click()

End Sub

Private Sub Image2_Click()

End Sub

Private Sub Label2_Click()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox2_Enter()

End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Image1.Picture = LoadPicture(TextBox2.Text)
End Sub

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (gvient)