CACHER UN MESSAGE DANS UNE IMAGE

Public Function CryptImage(ByVal PathImageSource As String, ByVal PathImageCrypt As String, ByVal Message As String) As Long
    Dim octet As Byte
    Dim i As Integer
    
    Open PathImageSource For Binary Access Read As #1   'ouverture de l'image originale
    Open PathImageCrypt For Binary Access Write As #2   'création de l'image avec le message
    
        While Not EOF(1)        'tant que non fin
            Get #1, , octet
            Put #2, , octet
        Wend
        
        For i = 1 To Len(Message)           'rajout du message octet par octet à la fin de l'image
            Put #2, , Asc(Mid(Message, i, 1))
        Next
    Close #1
    Close #2
    CryptImage = FileLen(PathImageSource) + 1   'point d'insertion du message = poids de l'image + 1
End Function


Public Function DecryptImage(ByVal PathImageCrypt As String, ByVal code As Long) As String
    Dim cpt As Long
    Dim octet As Byte
    Dim Message As String

    Open PathImageCrypt For Binary Access Read As #1   'ouverture de l'image contenant le message
        While Not EOF(1)
            Get #1, , octet
            cpt = cpt + 1
            If cpt > code Then      'si j'ai atteint le point d'insertion
                If Not octet = 0 Then
                    Message = Message & Chr(octet)  'recomposition du message
                End If
            End If
        Wend
    Close #1
    DecryptImage = Message      'on renvoie le message
End Function

' Utilisation de la dll
'
'Faire projet --> références --> parcourrir (selection de ma dll)
'
'Voici un exemple de code...
'
'
'Dim hehe As New SecretMessage.ClassSecretMessage
'    Dim code As Long
'    
'    code = hehe.CryptImage(App.Path & "\test.jpg", App.Path & "\modif.jpg", "La vie est formidable !")
'    MsgBox hehe.DecryptImage(App.Path & "\modif.jpg", code)

Télécharger le zip