Estaba yo buscando en las referencias del
Visual Basic y me encontré con una que ponía: COM MakeCab 1.0 Type Library
y me dije:
¡Anda! (por
no decir lo que realmente dije, que es posible que a algun@ le pueda molestar),
esto del MakeCab es para crear ficheros CABs, (comprimidos), vamos a probar si
se puede usar en el Visual Basic.
Así que me puse en la tarea de crear una pequeña utilidad para crear ficheros
de este tipo, lo pruebo y... ¡EUREKA! ¡FUNCIONA!
(es que algunas veces el Visual Basic no se entiende bien con todas las
referencias que te muestra)
Pero, casi siempre hay un pero, sólo
funciona en Windows 2000, he intentado usarla en Windows 98 y nada de nada,
entre otras cosas porque esa misma librería da otro objeto, me imagino que el
principal, ya que el nombre del fichero que muestra al pulsar sobre esa
librería de tipos en la lista de referencias es:
\WINNT\System32\catsrvut.dll\6 (fíjate en el \6 del final)
y el Windows 98 no lo interpreta igual que el Windows 2000... esto último son
suposiciones mias, ya que no se si el Windows 2000 usa ese último
"path" de forma especial... Si alguien lo sabe, que por favor me lo
explique.
De todas formas, usando la utilidad OLE View que se incluye en el Visual Studio, he creado un fichero IDL con la definición de esta "clase", así que si alguien se atreve a crear un fichero DLL o TLB para el Windows 98, más de uno estaríamos agradecidos. Yo voy a investigar un poco a ver si puedo hacerlo y si me atranco demasiado, ya buscaré a alguien que sepa hacerlo... de esta forma, serviría igualmente para el Windows 9x que para el 2000 e incluso para el NT... creo... el problema puede ser el uso de las librerías necesarias que seguramente sólo funcionarán en el Windows 2000, ya veremos.
Vamos a dejarnos de cavilaciones y pasemos al código.
Primero veamos una fotillo de la utilidad para
crear los ficheros CABs usando esta librería.
Abajo encontrarás un link con un fichero ZIP con todo lo aquí mostrado.
Para usar el programa:
- Escribe el nombre del fichero CAB en el
TextBox,
- Arrastra (drag & drop) los ficheros que
quieras incluir en ese CAB hasta el ListBox,
(si quieres quitar algún fichero de la lista, seleccionalos y pulsa la tecla Supr)
- Marca la opción de incluir el path junto
con el nombre si quieres usar la misma estructura de directorios
- pulsa en el botón Crear CAB y ya está.
En la barra de estado, (etiqueta del
copyright), te indicará si ya ha finalizado o no.
La utilidad en funcionamiento
El código de la utilidad de crear CABs en Windows 2000
En el menú Proyecto/Referencias selecciona COM
MakeCab 1.0 Type Library
Todo este código va en el mismo formulario.
'------------------------------------------------------------------------------
' gsMakeCabW2K (Prueba de MakeCab en Windows 2000) (30/Jun/00)
'
' Usando catsrvut.dll del directorio System32 del Windows 2000 Professional
'
' En las referencias seleccionar: COM MakeCab 1.0 Type Library
'
'
' ©Guillermo 'guille' Som, 2000
'------------------------------------------------------------------------------
Option Explicit
Private tMakeCab As COMMKCABLib.MakeCab
Private Sub cmdCrearCab_Click()
' Crear el fichero CAB y añadir los ficheros del listbox
Dim i As Long
Dim bProcesar As Boolean
On Error GoTo ErrCrearCab
bProcesar = False
' Sólo si hay ficheros que añadir
If lstFics.ListCount Then bProcesar = True
' Comprobar si hay asignado un nombre de fichero CAB
If bProcesar Then
If Len(txtCab) = 0 Then bProcesar = False
End If
' Si hay que procesar...
If bProcesar Then
lblStatus = " Creando el fichero " & SoloNombre(txtCab) & ", un momento por favor..."
lblStatus.Refresh
With tMakeCab
' Los parámetros: Fichero CAB, MakeSignable ??, ExtraSpace
' Nota: los dos últimos parámetros no se para que sirven...
.CreateCab txtCab, 1, 1024
For i = 0 To lstFics.ListCount - 1
' Los parámetros: Fichero a añadir, Fichero en el CAB
If chkExtraPath Then
.AddFile lstFics.List(i), lstFics.List(i)
Else
' Si no se quiere añadir el path al fichero CAB, quitárselo
.AddFile lstFics.List(i), SoloNombre(lstFics.List(i))
End If
Next
' Cerrar el fichero CAB
.CloseCab
End With
lblStatus = " Fichero " & SoloNombre(txtCab) & " creado."
lblStatus.Refresh
' A los 10 segundos se quitará este aviso y se pondrá el copyright
Timer1.Enabled = True
End If
Err = 0
Exit Sub
ErrCrearCab:
lblStatus = " Error " & Err.Number & " al crear el fichero CAB."
lblStatus.Refresh
MsgBox "Se ha producido el siguiente error:" & vbCrLf & _
Err.Number & " " & Err.Description
End Sub
Private Sub cmdSalir_Click()
Unload Me
End Sub
Private Sub Form_Load()
Set tMakeCab = New COMMKCABLib.MakeCab
' Poner el form en el centro de la pantalla y en la parte superior
Move (Screen.Width - Width) / 2, 0
lblStatus.Caption = " ©Guillermo 'guille' Som, 2000 (primera versión para Windows 2000 Pro: 30/Jun/2000)"
lblStatus.Tag = lblStatus.Caption
' Valores por defecto
txtCab = AppPath & "\PruebaMakeCab.cab"
Timer1.Enabled = False
End Sub
Private Function AppPath() As String
' Devuelve el path sin el \ final
Dim sPath As String
sPath = App.Path
If Right$(sPath, 1) = "\" Then
sPath = Left$(sPath, Len(sPath) - 1)
End If
AppPath = sPath
End Function
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
' Agregar los ficheros soltados en el formulario al ListBox o al TextBox
' Si el puntero del ratón está por encima del label del Listbox...
If Y < Label1(1).Top - 30 Then
' añadirlo al TextBox
Drop2Text Data
Else
' sino, en el ListBox
Drop2List Data
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Quitar la referencia al objeto creado
Set tMakeCab = Nothing
End Sub
Private Sub Label1_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
' Agregar el fichero soltado en el TextBox o en el ListBox
If Index = 0 Then ' Índice cero para el TextBox
Drop2Text Data
ElseIf Index = 1 Then ' Índice uno para el ListBox
Drop2List Data
End If
End Sub
Private Sub lstFics_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
' Agregar los ficheros soltados al ListBox
Drop2List Data
End Sub
Private Sub lstFics_KeyDown(KeyCode As Integer, Shift As Integer)
' Si se pulsa la tecla suprimir, borrar los ficheros seleccionados
Dim i As Long
If KeyCode = vbKeyDelete Then
With lstFics
' Hacer el bucle desde el final para que no de problemas al borrar
For i = .ListCount - 1 To 0 Step -1
' Si está seleccionado, quitar ese elemento
If .Selected(i) Then
.RemoveItem i
End If
Next
End With
End If
End Sub
Private Sub Timer1_Timer()
' Deshabilitar el temporizador y mostrar el copyright
Timer1.Enabled = False
lblStatus = lblStatus.Tag
End Sub
Private Sub txtCab_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
' Agregar el fichero soltado en el TextBox
Drop2Text Data
End Sub
Private Function SoloNombre(ByVal sFileName As String) As String
' Devuelve sólo el nombre del fichero sin el path
Dim i As Long
Dim sFic As String
sFic = sFileName
' Buscar el último \
For i = Len(sFileName) To 1 Step -1
If Mid$(sFileName, i, 1) = "\" Then
sFic = Mid$(sFileName, i + 1)
Exit For
End If
Next
SoloNombre = sFic
End Function
Private Sub Drop2List(Data As DataObject)
' Agregar los ficheros soltados al ListBox
Dim i As Long
On Error Resume Next
' Comprobar si son ficheros
If Data.GetFormat(vbCFFiles) Then
For i = 1 To Data.Files.Count
lstFics.AddItem Data.Files(i)
Next
End If
Err = 0
End Sub
Private Sub Drop2Text(Data As DataObject)
' Agregar el fichero soltado en el TextBox
Dim i As Long
Dim sFic As String
On Error Resume Next
' Comprobar si es un fichero
If Data.GetFormat(vbCFFiles) Then
txtCab = Data.Files(1)
'
' Si la extensión no es .CAB, cambiarla
sFic = txtCab
i = InStr(LCase$(sFic), ".cab")
If i = 0 Then
For i = Len(sFic) To 1 Step -1
If Mid$(sFic, i, 1) = "." Then
txtCab = Left$(sFic, i) & "cab"
Exit For
End If
Next
End If
End If
Err = 0
End Sub
---
Este es el listado del fichero catsrvut6.IDL para la creación de librerías de tipos:
// Generated .IDL file (by the OLE/COM Object Viewer)
//
// typelib filename: 6
[
uuid(8E17FFE3-C5BA-11D1-8D8A-0060088F38C8),
version(1.0),
helpstring("COM MakeCab 1.0 Type Library")
]
library COMMKCABLib
{
// TLib : // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
importlib("stdole2.tlb");
// Forward declare all types defined in this typelib
interface IMakeCab;
[
uuid(8E17FFF3-C5BA-11D1-8D8A-0060088F38C8),
helpstring("MakeCab Class")
]
coclass MakeCab {
[default] interface IMakeCab;
};
[
odl,
uuid(8E17FFF2-C5BA-11D1-8D8A-0060088F38C8),
helpstring("IMakeCab Interface"),
dual,
oleautomation
]
interface IMakeCab : IDispatch {
[id(0x00000001), helpstring("method CreateCab")]
HRESULT CreateCab(
[in] VARIANT CabFileName,
[in] VARIANT MakeSignable,
[in] VARIANT ExtraSpace);
[id(0x00000002), helpstring("method AddFile")]
HRESULT AddFile(
[in] VARIANT FileName,
[in] VARIANT FileNameInCab);
[id(0x00000003), helpstring("method CloseCab")]
HRESULT CloseCab();
[id(0x00000004), helpstring("method CopyFile")]
HRESULT CopyFile(
[in] VARIANT CabName,
[in] VARIANT FileNameInCab);
};
};
Espero que le saques algún provecho a esta utilidad.
Nos vemos.
Guillermo
El código de ejemplo y el fichero IDL está en este fichero zip: gsMakeCabW2K.zip (9.94 KB)
