Cacher des données binaires ou textes COMPRIMEES dans un EXE VB6
Résiste à un nouvelle complilation
Le fichier de données est comprimé si possible
en l'inclant dans un fichier bmp puis en le convertissant en PNG via GdiPlus.dll présent sur tous les PC depuis Windows2000
malheuresenment VB6 ne reconnait pas les PNG
26 octets sont mis en entête ce qui le fai apparaitre comme un BMP(OS2 2X4 16Mc) valide
cette image est chargée dans dans un picturebox caché ou non
ou dans un objet quelconque possédant une picture
pour extraire les données
on ouvre l'EXE (ou le FRX en mode debug)
on cherche les 26 octets d'entete
la longueur est inscrite juste avant (4 octets)
si le buffer correspond à un PNG
on le convertit en BMP via GdiPlus.dll
la longueur originale se trouve à l'adresse 54(0x36)
les données originales se trouvent à l'adresse 58(0x3A)
Source / Exemple :
Option Explicit
' Charger l'image préparée par File2Bmp Fichier_donnée, Fichier_bmp
' dans un objet possédant une picture (propriété .. picture)
' dans cet exemple Form1
' sauver le projet
Private Sub File2Bmp(F$, BmpFile$)
Dim NX%, NY%, L&, LC&, BMP$, PNG$
Dim B() As Byte, D() As Byte
BMP = TMP("bmp")
PNG = TMP("png")
L = File2Buf(F, B):
NX = Sqr((L + 4) / 48): NX = (NX - (NX = 0)) * 4
NY = 1 + (L + 3) \ (3 * NX)
BM D, NX, NY
CopyMemory D(54), L, 4
CopyMemory D(58), B(0), L
Buf2File BMP, D
If Convert(BMP, PNG, 1) = 0 Then If FileLen(PNG) < L Then L = File2Buf(PNG, B)
DeleteFileA BMP: DeleteFileA PNG: DeleteFileA BmpFile
NY = FreeFile
Open BmpFile For Binary As NY: Put NY, , A26: Put NY, , B: Close NY
End Sub
Private Function TMP$(SUF$)
TMP = Environ("TMP") & "\" & App.EXEName & "TMP." & SUF
End Function
Private Function A26$()
A26 = Replace("BM: ", " ", Chr(0))
End Function
Private Sub Command1_Click()
Open Text2 For Output As 2: Print #2, Text1;: Close 2
End Sub
Private Sub Command2_Click()
File2Bmp Text2, Text3
MsgBox "Rechargez Form1.picture=" & Text3
End Sub
Private Sub Form_Load()
Dim A$
Form1.Picture = LoadPicture() 'supprime la picture
Hidden2Str A
Text1 = A
Caption = App.EXEName
Text2 = Caption & ".txt"
Text3 = Caption & ".bmp"
End Sub
Private Function Hidden2Str(A$) As Boolean
Dim B() As Byte
Hidden2Str = Hidden2Buffer(B)
If Hidden2Str Then A = StrConv(B, vbUnicode)
End Function
Private Function Hidden2Buffer(Buffer() As Byte) As Boolean
Dim h%, I&, L&, A$
h = FreeFile
Open EXEorFRX For Binary As h
A = Space(LOF(h)): Get h, , A
I = InStr(A, Chr(0) & A26)
If I Then
Get h, I - 3, L
ReDim Buffer(L - 27)
Get h, I + 27, Buffer
Close h
If Buffer(0) = 137 Then 'is PNG
Buf2File TMP("png"), Buffer
If Convert(TMP("png"), TMP("bmp")) = 0 Then
Open TMP("bmp") For Binary As h
Get h, 55, L: ReDim Buffer(L - 1): Get h, , Buffer
Close h
Hidden2Buffer = True
End If
DeleteFileA TMP("png"): DeleteFileA TMP("bmp")
Else
Hidden2Buffer = True
End If
End If
End Function
Private Function EXEorFRX$()
EXEorFRX = App.Path
If Right(EXEorFRX, 1) <> "\" Then EXEorFRX = EXEorFRX & "\"
EXEorFRX = EXEorFRX & App.EXEName & IIf(DebugMode, ".frx", ".exe")
End Function
Private Function DebugMode() As Boolean
Dim A$
A = Space(300)
GetModuleFileNameA 0, A, 300
A = Left(A, InStr(A, Chr(0)) - 1)
DebugMode = (LCase(Right(A, 8)) = "\vb6.exe")
End Function
'et le BAS
Declare Sub GetModuleFileNameA Lib "kernel32" (ByVal hModule&, ByVal lpFileName$, ByVal nSize&)
Declare Sub DeleteFileA Lib "kernel32" (ByVal FileName$)
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal Length&)
Declare Function GdiplusStartup& Lib "gdiplus" (Token&, inputbuf As Any, Optional ByVal outputbuf&)
Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token&)
Declare Function GdipLoadImageFromFile& Lib "gdiplus" (ByVal FileName$, image&)
Declare Function GdipSaveImageToFile& Lib "gdiplus" (ByVal image&, ByVal FileName$, clsidEncoder As Any, encoderParams As Any)
Declare Sub GdipDisposeImage Lib "gdiplus" (ByVal image&)
Function Convert&(Source$, Destination$, Optional Q&)
'Q: 0Bmp 1Png 2Gif AutreQJpg
Dim img&, L&(11), T&, S$, Token&
L(4) = 1: If GdiplusStartup(Token, L(4)) Then Convert = 18: Exit Function
Convert = GdipLoadImageFromFile(StrConv(Source, vbUnicode), img): If Convert Then Exit Function
T = Q: If T = 1 Then T = 6
If Q > 2 Or Q < 0 Then
T = 1: L(5) = &H1D5BE4B5: L(6) = &H452DFA4A: L(7) = &HB35DDD9C
L(8) = &HEBE70551: L(9) = 1: L(10) = 4
If Q < 0 Then L(11) = VarPtr(Not Q) Else L(11) = VarPtr(Q)
End If
L(0) = &H557CF400 + T: L(1) = &H11D31A04: L(2) = &H739A&: L(3) = &H2EF31EF8
Convert = GdipSaveImageToFile(img, StrConv(Destination, vbUnicode), L(0), L(4)) ', ByVal 0) autre que Jpeg
GdipDisposeImage img: GdiplusShutdown Token
'Convert returns:
'0 Ok,GenericError,InvalidParameter,OutOfMemory
'4 ObjectBusy,InsufficientBuffer,NotImplemented,Win32Error
'8 WrongState,Aborted,FileNotFound,ValueOverflow
'12 AccessDenied,UnknownImageFormat,FontFamilyNotFound,FontStyleNotFound
'16 NotTrueTypeFont,UnsupportedGdiplusVersion,GdiplusNotInitialized,PropertyNotFound
'20 PropertyNotSupported
End Function
Public Function BM&(T() As Byte, X%, Y%)
BM = LXL(X): ReDim T(BM * Y + &H35): CopyMemory T(0), &H4D42, 2
CopyMemory T(2), BM * Y + &H36, 4: T(10) = &H36: T(14) = 40: CopyMemory T(18), X, 2
CopyMemory T(22), Y, 2: CopyMemory T(26), &H180001, 4
End Function
Public Function LXL&(X)
LXL = (3 * X + 3) And &H7FFC
End Function
Public Function File2Buf&(F$, B() As Byte)
Dim h%
h = FreeFile
Open F For Binary As h
File2Buf = LOF(h)
If File2Buf Then ReDim B(File2Buf - 1): Get h, , B Else B = ""
Close h
End Function
Public Sub Buf2File(F$, B() As Byte)
Dim h%
DeleteFileA F
h = FreeFile
Open F For Binary As h
Put h, , B
Close h
End Sub
Conclusion :
permet des faires des EXEs plus petits et sans fichiers dépendants
permet de cacher des données confidencielle
efficace
un peu de la bidouille
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.