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展開用の一時ファイルが残ります。
