Ver Mensaje Individual
  #9 (permalink)  
Antiguo 03/12/2009, 04:17
Avatar de erbuson
erbuson
 
Fecha de Ingreso: noviembre-2009
Mensajes: 701
Antigüedad: 14 años, 6 meses
Puntos: 53
Respuesta: Varios archivos en un solo (open binary)

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 original
  1. VERSION 5.00
  2. Begin VB.Form Form1
  3.    BorderStyle     =   1  'Fixed Single
  4.   Caption         =   "Form1"
  5.    ClientHeight    =   6615
  6.    ClientLeft      =   45
  7.    ClientTop       =   435
  8.    ClientWidth     =   10335
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.   ScaleHeight     =   6615
  12.    ScaleWidth      =   10335
  13.    StartUpPosition =   3  'Windows Default
  14.   Begin VB.CommandButton Command3
  15.       Caption         =   "Procesar"
  16.       Enabled         =   0   'False
  17.      Height          =   315
  18.       Left            =   8700
  19.       TabIndex        =   9
  20.       Top             =   420
  21.       Width           =   1575
  22.    End
  23.    Begin VB.CommandButton Command2
  24.       Caption         =   "Quitar"
  25.       Enabled         =   0   'False
  26.      Height          =   315
  27.       Left            =   5940
  28.       TabIndex        =   8
  29.       Top             =   420
  30.       Width           =   1575
  31.    End
  32.    Begin VB.CommandButton Command1
  33.       Caption         =   "Añadir"
  34.       Enabled         =   0   'False
  35.      Height          =   315
  36.       Left            =   4320
  37.       TabIndex        =   7
  38.       Top             =   420
  39.       Width           =   1575
  40.    End
  41.    Begin VB.ListBox List1
  42.       Height          =   5520
  43.       Left            =   4320
  44.       TabIndex        =   6
  45.       Top             =   1020
  46.       Width           =   5955
  47.    End
  48.    Begin VB.FileListBox File1
  49.       Height          =   4185
  50.       Left            =   60
  51.       TabIndex        =   2
  52.       Top             =   2340
  53.       Width           =   4215
  54.    End
  55.    Begin VB.DirListBox Dir1
  56.       Height          =   1890
  57.       Left            =   60
  58.       TabIndex        =   1
  59.       Top             =   360
  60.       Width           =   4215
  61.    End
  62.    Begin VB.DriveListBox Drive1
  63.       Height          =   315
  64.       Left            =   60
  65.       TabIndex        =   0
  66.       Top             =   60
  67.       Width           =   4215
  68.    End
  69.    Begin VB.Label Label4
  70.       BorderStyle     =   1  'Fixed Single
  71.      Height          =   255
  72.       Left            =   4320
  73.       TabIndex        =   10
  74.       Top             =   780
  75.       Width           =   5955
  76.    End
  77.    Begin VB.Label Label3
  78.       Alignment       =   1  'Right Justify
  79.      BorderStyle     =   1  'Fixed Single
  80.      Height          =   255
  81.       Left            =   9180
  82.       TabIndex        =   5
  83.       Top             =   60
  84.       Width           =   1035
  85.    End
  86.    Begin VB.Label Label2
  87.       Alignment       =   2  'Center
  88.      BorderStyle     =   1  'Fixed Single
  89.      Height          =   255
  90.       Left            =   7440
  91.       TabIndex        =   4
  92.       Top             =   60
  93.       Width           =   1695
  94.    End
  95.    Begin VB.Label Label1
  96.       BorderStyle     =   1  'Fixed Single
  97.      Height          =   255
  98.       Left            =   4380
  99.       TabIndex        =   3
  100.       Top             =   60
  101.       Width           =   3015
  102.    End
  103. End
  104. Attribute VB_Name = "Form1"
  105. Attribute VB_GlobalNameSpace = False
  106. Attribute VB_Creatable = False
  107. Attribute VB_PredeclaredId = True
  108. Attribute VB_Exposed = False
  109. Option Explicit
  110.  
  111. Private Sub Drive1_Change()
  112.   ' Cambiamos de Unidad
  113.  On Error GoTo NoDrive
  114.   Dir1.Path = Drive1.Drive
  115.   Dir1.Enabled = True
  116.   File1.Enabled = True
  117.   Exit Sub
  118. NoDrive:
  119.   Dir1.Enabled = False
  120.   File1.Enabled = False
  121.   MsgBox "Unidad no accesible", vbCritical, "Acceso a Unidad"
  122. End Sub
  123.  
  124. Private Sub Dir1_Change()
  125.   ' Cambiamos de Carpeta
  126.  File1.Path = Dir1.Path
  127. End Sub
  128.  
  129. Private Sub File1_Click()
  130.   ' Seleccionamos Archivo
  131.  Label1.Caption = File1.FileName
  132.   If Right$(File1.Path, 1) = "\" Then
  133.     Label1.ToolTipText = File1.Path & File1.FileName
  134.   Else
  135.     Label1.ToolTipText = File1.Path & "\" & File1.FileName
  136.   End If
  137.   Label2.Caption = FileDateTime(Label1.ToolTipText)
  138.   Label3.Caption = FileLen(Label1.ToolTipText)
  139.   ' Si no está en la lista permitirá añadirlo
  140.  Command1.Enabled = False
  141.   Dim i As Integer
  142.   For i = 0 To List1.ListCount - 1
  143.     If List1.List(i) = Label1.ToolTipText Then Exit Sub
  144.   Next
  145.   Command1.Enabled = True
  146. End Sub
  147.  
  148. Private Sub Command1_Click()
  149.   ' Añadimos archivo a la lista
  150.  List1.AddItem Label1.ToolTipText
  151.   Command1.Enabled = False
  152.   Command3.Enabled = True
  153. End Sub
  154.  
  155. Private Sub Command2_Click()
  156.   ' Quitamos archivo de la Lista
  157.  List1.RemoveItem List1.ListIndex
  158.   Command2.Enabled = False
  159.   If List1.ListCount = 0 Then Command3.Enabled = False
  160. End Sub
  161.  
  162. Private Sub Form_Load()
  163.   Label4 = "C:\Prueba.tot"
  164.   ContenidoDestino
  165. End Sub
  166.  
  167. Private Sub List1_Click()
  168.   ' Al seleccionar del List, permitimos eliminarlo
  169.  Command2.Enabled = True
  170. End Sub
  171.  
  172. Private Sub Command3_Click()
  173.   ' Añadimos los archivos
  174.  Dim Datos As String, i As Integer
  175.   If Dir(Label4) <> "" Then Kill Label4
  176.   Open Label4 For Binary As #1
  177.   For i = 0 To List1.ListCount - 1
  178.     Open List1.List(i) For Binary As #2
  179.     Datos = Space$(LOF(2))
  180.     Get #2, 1, Datos
  181.     Close #2
  182.     Put #1, LOF(1) + 1, Left$(List1.List(i) + Space$(128), 128) & Right$(Space$(10) & Len(Datos), 10) & Datos
  183.   Next
  184.   Close #1
  185.   Command3.Enabled = False
  186.   ContenidoDestino
  187. End Sub
  188.  
  189. Private Sub ContenidoDestino()
  190.   ' Contenido del archivo creado
  191.  List1.Clear
  192.   If Dir$(Label4) = "" Then Exit Sub
  193.   Dim Posicion As Long
  194.   Dim Nombre As String * 128
  195.   Dim Bytes As String * 10
  196.   Open Label4 For Binary As #1
  197.   Posicion = 1
  198.   Do
  199.     Get #1, Posicion, Nombre
  200.     Get #1, Posicion + 128, Bytes
  201.     List1.AddItem Trim$(Nombre)
  202.     Posicion = Posicion + 128 + 10 + Val(Bytes)
  203.     If Posicion > LOF(1) Then Exit Do
  204.   Loop
  205.   Close #1
  206. End Sub

Saludos