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)