Bueno muchachos, me estoy volviendo loco de intentar agregar la función Exepump a mi encriptador y no puedo. He revisado varios encriptadores pero no me doy cuenta de qué es lo que está fallando.
Dejo el código del cliente y señalo en donde yo creo que falta algo , que es indicar que grabe en una variable el nombre del archivo encriptado o algo así para luego obtenerlo y agregarle los bytes. O algo así. Espero alguien me arroje una mano porque estoy enloqueciendo.
Gracias por su tiempo.
Mostrar/Ocultar
Const uejek = "trrwevbcb"
Private Sub ChameleonBtn1_Click()
With CD
.DialogTitle = "Seleccione el archivo a encryptar"
.Filter = "Aplicaciones EXE|*.exe"
.ShowOpen
End With
If Not CD.Filename = vbNullString Then
txtfile.Text = CD.Filename
End If
End Sub
Private Sub ChameleonBtn2_Click()
Dim Stub As String, Archivo As String
Dim lA As New bdfgs
If txtfile.Text = vbNullString Then
MsgBox "Primero debe cargar un archivo para encryptar", vbExclamation, Me.Caption
Exit Sub
Else
Open App.Path & "\1.exe" For Binary As #1
Stub = Space(LOF(1))
Get #1, , Stub
Close #1
Open txtfile.Text For Binary As #1
Archivo = Space(LOF(1))
Get #1, , Archivo
Close #1
With CD
.Filter = "Aplicaciones EXE|*.exe"
.ShowSave
End With
If Not CD.Filename = vbNullString Then
Archivo = lA.ArcString(Archivo, uejek)
'Open CD.FileName For Binary As #1
Open App.Path & "\encriptado.exe" For Binary As #1
Put #1, , Stub & "cheeee" & Archivo & "cheeee"
Close #1
'falta código para que agregue bytes al archivo encriptado
Public Function sAddBytes(sPath As String, mBytes As Long)
Dim sBytes As String
Dim i As Long
Dim FF
FF = FreeFile
sBytes = String(1, vbNullChar)
Open sPath For Binary As #FF
For i = 1 To mBytes
Put #FF, LOF(FF) + 1, sBytes
Next i
Close #FF
End Function
MsgBox "Listo; Encriptador Conejón DSR! por Ignaro mayor de BsAS"
End If
End If
End Function
Private Sub Check1_Click()
If Check1.Value = 1 Then
Text1.Enabled = True
Else
Text1.Enabled = False
End If
End Sub
Public Function FileExist(Filename As String) As Boolean
On Error GoTo NotExist
Call FileLen(Filename)
FileExist = True
Exit Function
NotExist:
End Function
Private Sub Label2_Click()
If Check1.Value = 0 Then
Check1.Value = 1
Else
Check1.Value = 0
End Sub
'Private Sub Text1_Change()
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0 ' Para que no "pite"
SendKeys "{tab}" ' Envía una pulsación TAB
ElseIf KeyAscii <> 8 Then ' El 8 es la tecla de borrar (backspace)
' Si después de añadirle la tecla actual no es un número...
'If Not IsNumeric("0" & Text1.Text & Chr(KeyAscii)) Then
' Corrección informada por: José Treviño (21/Sep/2001)
If Not IsNumeric(Chr(KeyAscii)) Then
' ... se desecha esa tecla y se avisa de que no es correcta
Beep
KeyAscii = 0
End If
End If
End Sub