Recursos Visual Basic.NET, VB.NET, Manuales de programación, Tutoriales, Foros de programación, Comunidad de programadores

WinRAR aC:\ZipNuevo.zip C:\Foto.Bmp
WinZIP -aC:\ZipNuevo.zip C:\Foto.Bmp

WinRAReC:\ZipNuevo.zip C:\
WinZIP -eC:\ZipNuevo.zip C:\

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
Dim WinRar As String, WinZip As String
Public Function GetShortPath(strFileName As String) As String
 Dim Ret As Long, strPath As String
 strPath = String$(165, 0)
 Ret = GetShortPathName(strFileName, strPath, 164)
 GetShortPath = Left(strPath, Ret)
End Function
Private Sub Command1_Click()
Dim FileZipName As String, PathToCompress As String, DestPath As String, FullPathZip As String
'Ruta existente en la que se comprimira el archivo
DestPath = "C:\"
'nombre que le asignaremos al zip
FileZipName = "ArchivoComprimido.zip"

'es nesesario utilizar el nombre corto para que funcione
FullPathZip = GetShortPath(DestPath) & "\" & FileZipName

'Archivo o carpeta exitente que se quiere comprimir
PathToCompress = "C:\Archivos de programa\Windows NT\Pinball\SOUND1.WAV"
'nombre corto
PathToCompress = GetShortPath(PathToCompress)

If WinRar <> "" Then
 Shell WinRar & " a " & FullPathZip & " " & PathToCompress ', vbHide
Else
 Shell WinZip & " -a " & FullPathZip & " " & PathToCompress ', vbHide
End If
End Sub

Private Sub Command2_Click()
Dim FullPathZip As String, FolderToDescompress As String
'Ruta existente del archivo comprimirdo
FullPathZip = "C:\ArchivoComprimido.zip"
'carpeta existente que se va a descomprimir el zip
FolderToDescompress = "C:\"
'Combercion a nombre corto
FullPathZip = GetShortPath(FullPathZip)
FolderToDescompress = GetShortPath(FolderToDescompress)
If WinRar <> "" Then
 Shell WinRar & " e " & FullPathZip & " " & FolderToDescompress ', vbHide
Else
 Shell WinZip & " -e " & FullPathZip & " " & FolderToDescompress ', vbHide
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim MiObjeto As Object, Ret As String
Set MiObjeto = CreateObject("Wscript.Shell")
Ret = MiObjeto.RegRead("HKEY_CLASSES_ROOT\WinRAR\shell\open\command\")
WinRar = Left(Ret, InStrRev(Ret, " "))

Ret = MiObjeto.RegRead("HKEY_CLASSES_ROOT\WinZip\shell\open\command\")
WinZip = Left(Ret, InStrRev(Ret, " "))
Set MiObjeto = Nothing
Command1.Caption = "Comprimir"
Command2.Caption = "Descomprimir"
If WinRar & WinZip = "" Then
 MsgBox "No se encuentra instalado ni WinZip ni WinRar :("
 End
End If
End Sub