Cacher des données comprimées les exe et les frx(vb6)

Soyez le premier à donner votre avis sur cette source.

Vue 3 401 fois - Téléchargée 420 fois

Télécharger le projet
Commenter

Description

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
Télécharger le projet

Codes Sources

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 (deleplace)