STÉGANOGRAPHIE - CACHER UNE IMAGE DANS UNE AUTRE IMAGE

Signaler
Messages postés
80
Date d'inscription
dimanche 29 décembre 2002
Statut
Membre
Dernière intervention
1 octobre 2004
-
Messages postés
80
Date d'inscription
dimanche 29 décembre 2002
Statut
Membre
Dernière intervention
1 octobre 2004
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/8424-steganographie-cacher-une-image-dans-une-autre-image

Messages postés
80
Date d'inscription
dimanche 29 décembre 2002
Statut
Membre
Dernière intervention
1 octobre 2004

c'est une source prometteuse. je me suis juste permis de remanier toutes ces fonctions de manipulation de bits et décimal. voila ce que je te propose. il me semble que c'est plus efficace et plus simple à maintenir. :

Option Explicit

Public Enum Poids
Faible = 2
Fort = 4
Perso = 8
End Enum

Public Function Bin2Dec(nBinaire As String) As Long
Dim n, a As Long
Dim x As String
Dim Resultat As Long
n = Len(nBinaire) - 1
a = n
Do While n > -1
x = Mid(nBinaire, ((a + 1) - n), 1)
Resultat IIf((x "1"), Resultat + (2 ^ (n)), Resultat)
n = n - 1
Loop
Bin2Dec = Resultat
End Function
Public Function Dec2Bin(ByVal Octets As Long, Optional pOctet As Poids Faible, Optional pLong As Integer 8) As String
Dim LoopCounter As Integer
Dim Resultat As String
Resultat = ""
Do
If (Octets And 2 ^ LoopCounter) = 2 ^ LoopCounter Then
Resultat = "1" & Resultat
Else
Resultat = "0" & Resultat
End If
LoopCounter = LoopCounter + 1
Loop Until 2 ^ LoopCounter > Octets

Resultat = Trim(Resultat)
If Len(Resultat) < pLong Then
Resultat = FillStr(Resultat, "0", pLong)
End If
Select Case pOctet
Case 2 'faible
If Len(Resultat) > 8 Then
Resultat = Mid(Resultat, Len(Resultat) - 8, 8)
End If
Resultat = Mid(Resultat, 5, 4)
Case 4 'fort
If Len(Resultat) > 8 Then
Resultat = Mid(Resultat, Len(Resultat) - 8, 8)
End If
Resultat = Mid(Resultat, 1, 4)
Case 8 'perso
Resultat = Mid(Resultat, (Len(Resultat) - pLong) + 1, pLong)
End Select

Dec2Bin = Resultat

End Function

Public Function FillStr(ByVal Texte As String, Filler As String, Taille As Integer) As String
If Len(Texte) > Taille Then Exit Function
If Len(Filler) > 1 Then
Filler = Mid(Filler, 1, 1)
End If
Do While Len(Texte) < Taille
Texte = Filler & Texte
Loop

FillStr = Texte

End Function