Autor
|
Tema: Ayuda con cambio de Icono en Cripter (Leído 2,478 veces)
|
Yeshua
Desconectado
Mensajes: 373
Continuamente aprendiendo
|
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.
|
|
|
En línea
|
|
|
|
el_c0c0
Desconectado
Mensajes: 307
|
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
|
|
|
En línea
|
'- coco "Te voy a romper el orto"- Las hemorroides
|
|
|
WestOn
Desconectado
Mensajes: 272
El testamento Maya...
|
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
|
|
|
En línea
|
En mi cabeza existe una barrera espacio-tiempo de 4cm³. ¿Alguien sabe como eliminarla?.
|
|
|
Yeshua
Desconectado
Mensajes: 373
Continuamente aprendiendo
|
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é.
|
|
|
En línea
|
|
|
|
aaronduran2
|
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
|
|
« Última modificación: 23 Febrero 2009, 21:16 pm por aaronduran2 »
|
En línea
|
|
|
|
Yeshua
Desconectado
Mensajes: 373
Continuamente aprendiendo
|
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.
|
|
« Última modificación: 3 Marzo 2009, 14:48 pm por Yeshua »
|
En línea
|
|
|
|
|
|