2017年11月
      1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30    
無料ブログはココログ

« ZIPファイルの中身を削除するバッチファイル(その2) | トップページ | VB.NETでZIP圧縮コマンドを作る。(その2) »

2008年6月16日 (月)

VB.NETでZIP展開コマンドを作る。

IE7に対応。

ExtractZIP.exe ZIPファイル [展開先フォルダ\][ファイル名またはフォルダ名]...

vbc ExtractZIP.VB

Option Explicit
Imports Microsoft.VisualBasic
Imports System
Imports System.IO

Public Class Zip
Public Shared Function Main(ByVal Arguments() As String) As Integer
If Arguments.Length<1 Then
  Console.Error.WriteLine("Arguments Missing.")
  Console.Error.WriteLine("Usage: ExtractZip zipfile files...")
  Return 1
End If
If Path.GetExtension(Arguments(0).ToLower()) <> ".zip" Then
  Console.Error.WriteLine("Invalid Extension Name - " & Arguments(0))
  Return 1
End If
If Not File.Exists(Arguments(0)) Then
  Console.Error.WriteLine("File Not Found. - " & Arguments(0))
  Return 1
End If
Dim ie As Object = Nothing
Dim Shell As Object
Try
'IE7以降も可
  Shell = CreateObject("Shell.Application")
  Dim ZIPfile As String = Shell.NameSpace(Path.GetFullPath(Arguments(0))).Self.Path
  Shell.ShellExecute("explorer.exe",ZIPfile,,,0)
  Do
    For Each ie In Shell.Windows()
      If ie.Visible Then
      ElseIf InStr(TypeName(ie.Document),"IShellFolderViewDual") Then
        If ie.Document.Folder.Self.Path = ZIPfile Then Exit Do
      End If
    Next
    ie = Nothing
    Threading.Thread.Sleep(100)
  Loop
'  ie = CreateObject("InternetExplorer.Application") 'IE7以降ダメ
'  ie = GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}") 'IE7以降も可
'  ie.Navigate(Path.GetFullPath(Arguments(0))
  Do While ie.Busy OrElse ie.ReadyState <> 4
    Threading.Thread.Sleep(100)
  Loop
  Shell = ie.Document.Application
  Dim zFolder As Object = ie.Document.Folder
  If Arguments.Length = 1 Then
    Dim dFolder As Object = Shell.NameSpace((Environment.CurrentDirectory))
    dFolder.CopyHere((zFolder.Items()))
  ElseIf Arguments.Length = 2 AndAlso Arguments(1).EndsWith("\") Then
    If Not Directory.Exists(Arguments(1)) Then
      Console.Error.WriteLine("Folder Not Found. - " & Arguments(1))
      Return 1
    End If
    Dim dFolder As Object = Shell.NameSpace(Path.GetFullPath(Arguments(1)))
    dFolder.CopyHere((zFolder.Items()))
  Else
    Dim k As Integer
    For k = 1 To Arguments.Length-1
      Dim FileName As String = Path.GetFileName(Arguments(k))
      Dim FolderName As String = Path.GetDirectoryName(Arguments(k))
      If FolderName<>"" AndAlso Not Directory.Exists(FolderName) Then
        Console.Error.WriteLine("Folder Not Found. - " & FolderName)
        Exit For
      End If
      Dim dFolder As Object = Shell.Namespace(Path.GetFullPath(Arguments(k) & "\.."))
      Dim zFolderItem As Object = zFolder.ParseName(FileName)
      If zFolderItem Is Nothing Then
        Console.Error.WriteLine("File Not Found. - " & FileName)
        Exit For
      End If
      dFolder.CopyHere(zFolderItem)
    Next
  End If
Catch
  Console.Error.WriteLine("Source" & vbTab & vbTab & Err.Source & vbLf & "Number" & vbTab & vbTab & Err.Number & vbLf & "Description" & vbTab & Err.Description & vbLf & "DLL Error" & vbTab & Err.LastDLLError)
  Return 3
Finally
  If TypeName(ie) = "IWebBrowser2" Then ie.Quit()
End Try
End Function
End Class

« ZIPファイルの中身を削除するバッチファイル(その2) | トップページ | VB.NETでZIP圧縮コマンドを作る。(その2) »