gsMakeCabW2K

Utilidad para crear ficheros CAB en Windows 2000
(usando COM MakeCab 1.0 Type Library)


Publicado: 1/Jul/2000
Actualizado: 11/Feb/2005
Autor: Guillermo 'guille' Som
Nota 11/Feb/2005: Si quieres ver la versión para Windows XP.


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:

En la barra de estado, (etiqueta del copyright), te indicará si ya ha finalizado o no.

gsMakeCabW2K
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)


ir al índice