Foro de elhacker.net

Public Class Form1
Dim ventanaabrirarchivo As New OpenFileDialog
Dim original As String

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As Sytem.EventArgs) Handles BtnExaminar.Click
        ventanaabrirarchivo.ShowDialog(Me)
        TextBox1.Text = ventanaabrirarchivo.FileName
        original = Leerlosdatosdearchivo(TextBox1.Text) 'funcion mas abajo
    End Sub

    Public Function Leerlosdatosdearchivo(ByRef rutaarchivooriginal As String) As String
        Dim cadenaenblancoreserva As String
        Dim canallibre
        canallibre = FreeFile()
        FileOpen(canallibre, rutaarchivooriginal, OpenMode.Binary)
        cadenaenblancoreserva = Space(LOF(canallibre)) 
        FileGet(canallibre, cadenaenblancoreserva)
        FileClose(canallibre)
        Return cadenaenblancoreserva
    End Function
End Class

 Dim original As String
 TextBox1.Text = ventanaabrirarchivo.FileName
 original = Leerlosdatosdearchivo(TextBox1.Text) 'funcion mas abajo
End Sub

    Public Function Leerlosdatosdearchivo(ByRef rutaarchivooriginal As String) As String
        Dim cadenaenblancoreserva As String
        Dim canallibre
        canallibre = FreeFile()
        FileOpen(canallibre, rutaarchivooriginal, OpenMode.Binary)
        cadenaenblancoreserva = Space(LOF(canallibre)) 
        FileGet(canallibre, cadenaenblancoreserva)
        FileClose(canallibre)
        Return cadenaenblancoreserva
    End Function

FileOpen(1, Application.StartupPath & "\Stub.exe", OpenMode.Binary, OpenAccess.Read, OpenShare.Default) 'ABRE EL EJECUTABLE LLAMADO STUB.EXE EN LA MISMA RUTA QUE EL EJECUTABLE ABIERTO ANTERIORMENTE
        stub = Space(LOF(1))
        FileGet(1, stub)
        FileClose(1)
        Return stub

 FileOpen(1,rutaarchivooriginal,OpenMode.Binary,OpenAccess.ReadWrite,OpenShare.Default)
 FilePut(1, rc4(original)) 
 FileClose(1)
'AHORA EL ALGORITMO
Public Function rc4(ByVal binarioarchivoriginal As String) As String 'algoritmo a cifrar el original
        Dim password As String = "yo"
        Dim i As Integer = 0
        Dim j As Integer = 0
        .....
      

Dim rutadelarchivonuevo As String = botonencryptar() 'DENTRO DEL EVENTO CLICK AL BOTON cifrar
Private Function botonencryptar()
        Dim x As New SaveFileDialog
        Dim rutadelarchivonuevo As String = ""
        If x.ShowDialog = Windows.Forms.DialogResult.OK Then
            rutadelarchivonuevo = x.FileName
        End If
        Return rutadelarchivonuevo
End Function
Private Sub creararchivonuevo(ByVal rutadelarchivonuevo As String)
        FileOpen(1, rutadelarchivonuevo, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Default)
                FilePut(1, stub & "atomarvientos" & original) 
        FileClose(1)
End Sub

Public Class Form1   
    
    Dim original As String
    Dim originalencriptado As String
    Dim lecturastub As String
      
   Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnExaminar.Click
        'abrimos el cuadro de dialogo para seleccionar el archivo nuevo
         Dim ventanaabrirarchivo As New OpenFileDialog
         ventanaabrirarchivo.ShowDialog(Me)
         TextBox1.Text = ventanaabrirarchivo.FileName
         original = Leerlosdatosdearchivo(TextBox1.Text) ' LA VARIABLE ORIGINAL  TENDRA EL ARCHIVO BINARIO DEL ARCHIVO ORIGINAL
         originalencriptado = xEncryption(original, "batidora") 'funcion para encryptar el original
    End Sub 

' LEEMOS EL ARCHIVO ORIGINAL Y LO DEVOLVEMOS EN LA VARIABLE CADENAENBLANCORESERVA
 Public Function Leerlosdatosdearchivo(ByRef rutaarchivooriginal As String) As String
        Dim cadenaarellenar As String
        Dim canallibre As Integer

        canallibre = FreeFile()
        FileOpen(canallibre, rutaarchivooriginal, OpenMode.Binary)
        cadenaarellenar = Space(LOF(canallibre)) 
        FileGet(canallibre, cadenaarellenar)
        FileClose(canallibre)
        Return cadenaarellenar
 End Function[/color]   
 
'CIFRAR CON ALGORITMO EL BINARIO ORIGINAL
  Public Function xEncryption(ByVal archivooriginal As String, ByVal batidora As String) As String
        Dim lonDataPtr As Long
        Dim strDataOut As String
        Dim temp As Integer
        Dim tempstring As String
        Dim intXOrValue1 As Integer
        Dim intXOrValue2 As Integer
        For lonDataPtr = 1 To Len(batidora)
            intXOrValue1 = Asc(Mid$(batidora, lonDataPtr, 1))
            intXOrValue2 = Asc(Mid$(archivooriginal, ((lonDataPtr Mod Len(archivooriginal)) + 1), 1))
            temp = (intXOrValue1 Xor intXOrValue2)
            tempstring = Hex(temp)
            If Len(tempstring) = 1 Then tempstring = "0" & tempstring
            strDataOut = strDataOut + tempstring
        Next lonDataPtr
        xEncryption = strDataOut
    End Function

    'LEEMOS LOS DATOS DEL STUB Y LOS GUARDAMOS EN LA VARIABLE LECTURASTUB
   Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        FileOpen(1, "C:\Users\Administrador\Desktop\Stub.exe", OpenMode.Binary, OpenAccess.Read, OpenShare.Default)
        lecturastub = Space(LOF(1))
        FileGet(1, lecturastub)
        FileClose(1)
    End Sub   

 ' CREA UN NUEVO ARCHIVO CON LOS DATOS DEL STUB + SEPARADOR + ORIGINAL CIFRADO
 Private Sub BtnEncriptar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnEncriptar.Click

        'funcion para abrir cuadro de texto para guardar archivo
        Dim rutadelarchivonuevo As String = guardararchivo(rutadelarchivonuevo)
        ' ahora el pastel
        FileOpen(1, rutadelarchivonuevo, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.Default)
        FilePut(1, lecturastub & "atomarvientos" & originalencriptado)
        FileClose(1)
        MsgBox("Realizado")
  End Sub

    'FUNCION PARA GUARDAR UN ARCHIVO NUEVO QUE DEVUELVE LA RUTA DEL ARCHIVO NUEVO
 Private Function guardararchivo(ByVal rutadelarchivonuevo As String) As String
        Dim x As New SaveFileDialog
        If x.ShowDialog = Windows.Forms.DialogResult.OK Then
            rutadelarchivonuevo = x.FileName
        End If
        Return rutadelarchivonuevo
   End Function

End Class