« VB.NETでZIP展開コマンドを作る。 | トップページ | PowerShellでZIP展開する。 »

2008年6月17日 (火)

VB.NETでZIP圧縮コマンドを作る。(その2)

IE7に対応。

置換確認ダイアログを出さずに置換します。

MakeExZIP.exe ZIPファイル ファイル...

vbc MakeExZIP.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<2 Then
  Console.Error.WriteLine("Arguments Missing.")
  Console.Error.WriteLine("Usage: MakeExZip 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
Try
  Dim ie As Object = Nothing
  Dim Shell As Object
  Dim zFolder As Object
  If File.Exists(Arguments(0)) Then
'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
    zFolder = ie.Document.Folder
  Else
    Dim fs As FileStream = File.Create(Arguments(0))
    Dim b As Byte() = {&H50, &H4B, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
    fs.Write(b,0,b.Length)
    fs.Close()
    Shell = CreateObject("Shell.Application")
    zFolder = Shell.NameSpace(Path.GetFullPath(Arguments(0)))
  End If
  Dim k As Integer
  Dim tFolderName As String = ""
  Dim tFolder As Object = Nothing
  For k = 1 To Arguments.Length-1
    Dim FileName As String = Path.GetFileName(Arguments(k))
    Dim sFolderItem As Object = Shell.NameSpace(Path.GetFullPath(Arguments(k) & "\..")).ParseName(FileName)
    If sFolderItem Is Nothing Then
      Console.Error.WriteLine("File Not Found. - " & Arguments(k))
      Exit For
    End If
    Dim Count As Integer
    Dim zFolderItem As Object = zFolder.ParseName(FileName)
    If Not zFolderItem Is Nothing Then
      If tFolderName="" Then
        tFolderName = Path.GetTempFileName()
        File.Delete(tFolderName)
        Directory.CreateDirectory(tFolderName)
        tFolder = Shell.NameSpace((tFolderName))
      End If
      Count = zFolder.Items().Count
'      tFolder.MoveHere(zFolderItem)
      zFolderItem.InvokeVerb("cut")
      tFolder.Self.InvokeVerb("paste")
      Do While zFolder.Items().Count <> Count - 1
        Threading.Thread.Sleep(1000)
      Loop
      zFolderItem = Nothing
    End If
    Count = zFolder.Items().Count
    zFolder.CopyHere(sFolderItem)
    Do While zFolder.Items().Count <> Count + 1
      Threading.Thread.Sleep(1000)
    Loop
    sFolderItem = Nothing
  Next
  tFolder = Nothing
  zFolder = Nothing
  Shell = Nothing
  If Not ie Is Nothing Then ie.Quit()
  Do While TypeName(ie) = "IWebBrowser2"
    Threading.Thread.Sleep(1000)
  Loop
  If tFolderName<>"" Then
    Directory.Delete(tFolderName,True)
  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
End Try
End Function
End Class

一部のShellのメソッドでは型変換のため、(())で変数を式にする必要があります。
一部のShellのオブジェクトでは、参照の解放(Nothingの代入)がないと、ZIP展開用の一時ファイルが残ります。

« VB.NETでZIP展開コマンドを作る。 | トップページ | PowerShellでZIP展開する。 »