Hola:
Jugando un poco con la idea, he creado el siguiente ejemplo.
De momento lo unico que hace es crear el archivo Unificado, deben controlarse posibles errores de tamaño de grandes archivos, extraccion, etc.
Basta con Copiar y pegar el siguiente código en el Bloc de Notas y ponerle la extension .frm al archivo creado.
Código vb:
Ver originalVERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 6615
ClientLeft = 45
ClientTop = 435
ClientWidth = 10335
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6615
ScaleWidth = 10335
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command3
Caption = "Procesar"
Enabled = 0 'False
Height = 315
Left = 8700
TabIndex = 9
Top = 420
Width = 1575
End
Begin VB.CommandButton Command2
Caption = "Quitar"
Enabled = 0 'False
Height = 315
Left = 5940
TabIndex = 8
Top = 420
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "Añadir"
Enabled = 0 'False
Height = 315
Left = 4320
TabIndex = 7
Top = 420
Width = 1575
End
Begin VB.ListBox List1
Height = 5520
Left = 4320
TabIndex = 6
Top = 1020
Width = 5955
End
Begin VB.FileListBox File1
Height = 4185
Left = 60
TabIndex = 2
Top = 2340
Width = 4215
End
Begin VB.DirListBox Dir1
Height = 1890
Left = 60
TabIndex = 1
Top = 360
Width = 4215
End
Begin VB.DriveListBox Drive1
Height = 315
Left = 60
TabIndex = 0
Top = 60
Width = 4215
End
Begin VB.Label Label4
BorderStyle = 1 'Fixed Single
Height = 255
Left = 4320
TabIndex = 10
Top = 780
Width = 5955
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
Height = 255
Left = 9180
TabIndex = 5
Top = 60
Width = 1035
End
Begin VB.Label Label2
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Height = 255
Left = 7440
TabIndex = 4
Top = 60
Width = 1695
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Height = 255
Left = 4380
TabIndex = 3
Top = 60
Width = 3015
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Drive1_Change()
' Cambiamos de Unidad
On Error GoTo NoDrive
Dir1.Path = Drive1.Drive
Dir1.Enabled = True
File1.Enabled = True
Exit Sub
NoDrive:
Dir1.Enabled = False
File1.Enabled = False
MsgBox "Unidad no accesible", vbCritical, "Acceso a Unidad"
End Sub
Private Sub Dir1_Change()
' Cambiamos de Carpeta
File1.Path = Dir1.Path
End Sub
Private Sub File1_Click()
' Seleccionamos Archivo
Label1.Caption = File1.FileName
If Right$(File1.Path, 1) = "\" Then
Label1.ToolTipText = File1.Path & File1.FileName
Else
Label1.ToolTipText = File1.Path & "\" & File1.FileName
End If
Label2.Caption = FileDateTime(Label1.ToolTipText)
Label3.Caption = FileLen(Label1.ToolTipText)
' Si no está en la lista permitirá añadirlo
Command1.Enabled = False
Dim i As Integer
For i = 0 To List1.ListCount - 1
If List1.List(i) = Label1.ToolTipText Then Exit Sub
Next
Command1.Enabled = True
End Sub
Private Sub Command1_Click()
' Añadimos archivo a la lista
List1.AddItem Label1.ToolTipText
Command1.Enabled = False
Command3.Enabled = True
End Sub
Private Sub Command2_Click()
' Quitamos archivo de la Lista
List1.RemoveItem List1.ListIndex
Command2.Enabled = False
If List1.ListCount = 0 Then Command3.Enabled = False
End Sub
Private Sub Form_Load()
Label4 = "C:\Prueba.tot"
ContenidoDestino
End Sub
Private Sub List1_Click()
' Al seleccionar del List, permitimos eliminarlo
Command2.Enabled = True
End Sub
Private Sub Command3_Click()
' Añadimos los archivos
Dim Datos As String, i As Integer
If Dir(Label4) <> "" Then Kill Label4
Open Label4 For Binary As #1
For i = 0 To List1.ListCount - 1
Open List1.List(i) For Binary As #2
Datos = Space$(LOF(2))
Get #2, 1, Datos
Close #2
Put #1, LOF(1) + 1, Left$(List1.List(i) + Space$(128), 128) & Right$(Space$(10) & Len(Datos), 10) & Datos
Next
Close #1
Command3.Enabled = False
ContenidoDestino
End Sub
Private Sub ContenidoDestino()
' Contenido del archivo creado
List1.Clear
If Dir$(Label4) = "" Then Exit Sub
Dim Posicion As Long
Dim Nombre As String * 128
Dim Bytes As String * 10
Open Label4 For Binary As #1
Posicion = 1
Do
Get #1, Posicion, Nombre
Get #1, Posicion + 128, Bytes
List1.AddItem Trim$(Nombre)
Posicion = Posicion + 128 + 10 + Val(Bytes)
If Posicion > LOF(1) Then Exit Do
Loop
Close #1
End Sub
Saludos
