2008年7月 4日 (金)

window.close()で警告ダイアログを出さないで閉じる。

いろいろ方法があるようですが、

window.close()

の代わりに、

window.open("about:blank","_self").close()

同様に、

window.parent.close()

window.top.close()

の代わりに、

window.open("about:blank","_parent").close()

window.open("about:blank","_top").close()

2008年7月 3日 (木)

バッチで、複数のコマンドを並列実行して、直後に一括して待ち合わせる。

コマンドライン1 >&2 | コマンドライン2 >&2 | コマンドライン3
とします。

標準出力がないなら >&2 は不要です。

notepad.exe | notepad.exe | notepad.exe
みたいに。

2008年7月 2日 (水)

バッチから非同期に起動したアプリの終了を待ち合わせる。

start notepad.exe >running.1
で、非同期に起動し、

del running.1
if exist running.1 (echo 実行中) else echo 終了済
で、実行中か終了済かを判定し、

:wait
del running.1
if exist running.1 sleep.exe 1 & goto :wait
で、待ち合わせます。

複数の場合は、running.1の数字を変えて。

sleep.exeがないときは、ping.exe localhost -n 2 で代替して。

2008年7月 1日 (火)

現在のセキュリティ設定では、このファイルをダウンロードできません。

ダウンロードできないとき、
---------------------------
セキュリティの警告
---------------------------
現在のセキュリティ設定では、このファイルをダウンロードできません。
---------------------------
OK   
---------------------------
というダイアログが出ます。

このとき、そのダイアログの後ろに、もうひとつ、
---------------------------
0% / URL - ファイル名 完了しました
---------------------------
ファイルの情報を取得しています...
URL - ファイル名
---------------------------
というダイアログが出ていることがあります。

後ろのダイアログがないときは、そのセキュリティゾーンのセキュリティレベルで、
「ファイルのダウンロード」を「無効にする」→「有効にする」
後ろのダイアログがあるときは、前者の設定に加えて、
「アプリケーションと安全でないファイルの起動」を「無効にする」→「ダイアログを表示する」

つまり、アプリケーションと安全でないファイルのダウンロードには二重に鍵が掛かっているということです。

2008年6月27日 (金)

IEをデザインモードに変える。

なぜか、IEのメニューにないので、コンテキストメニューを拡張します。

DesignMode.htm

<script>
external.menuArguments.top.document.designMode='On';
</script>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\デザインモードに変更(&D)]
@="C:\\どこか\\DesignMode.htm"

逆の「ブラウズ表示」に戻すほうは、IEのコンテキストメニューにあります。

2008年6月25日 (水)

XP + IE7 で、Microsoft Internet Controls の参照設定が変です。

XP + IE6 では、Microsoft Internet Controls の参照先は、
C:\WINDOWS\system32\shdocvw.dll
ですが、IE7を入れると、
C:\WINDOWS\system32\ieframe.dll
に変わります。

ところが、その状態では、いろいろ問題が出るようです。

例えば、IE7のShell/IE分離に対応して、Shellを起こそうと、
Dim ie As SHDocVw.ShellBrowserWindow
Set ie = New SHDocVw.ShellBrowserWindow
とすると、エラーになります。

その場合、一度、Microsoft Internet Controls の参照設定を外して、
C:\WINDOWS\system32\shdocvw.dll
を参照設定し直します。

2008年6月24日 (火)

テキストファイルの行数を調べる。

よくあるのは、FSOで追加書き込みでオープンして、Lineプロパティを見るものです。

Function NumberOfLines(File)
Const forAppending=8
Dim TStream
Set TStream=CreateObject("Scripting.FileSystemObject").OpenTextFile(File,forAppending)
NumberOfLines=TStream.Line
End Function

しかし、このやり方には以下の問題があります。
出力オープンがエラーになることがある。
行数に1行の誤差が出ることがある。

なら、FSOでReadオープンしてSkipLineで数えれば、そういう問題はありません。

Function NumberOfLines(File)
Dim TStream
NumberOfLines=0
Set TStream=CreateObject("Scripting.FileSystemObject").OpenTextFile(File)
Do While Not TStream.AtEndOfStream
  TStream.SkipLine
  NumberOfLines=NumberOfLines+1
Loop
End Function

でも、性能が気になります。

じゃ、一度にすべて読めば、速い?

Function NumberOfLines(File)
Dim TStream
Set TStream=CreateObject("Scripting.FileSystemObject").OpenTextFile(File)
If Not TStream.AtEndOfStream Then TStream.ReadAll
NumberOfLines=TStream.Line+(TStream.Column=1)
End Function

今度は、メモリが気になります。

そこで、すべて読み飛ばします。

Function NumberOfLines(File)
Dim TStream
Set TStream=CreateObject("Scripting.FileSystemObject").OpenTextFile(File)
Do While Not TStream.AtEndOfStream
  TStream.Skip 1073741824
Loop
NumberOfLines=TStream.Line+(TStream.Column=1)
End Function

ところで、この TStream.Line+(TStream.Column=1) の意味は?

TStream.Line は、UBound(Split(vbLf & TStream..ReadAll,vbLf)) みたいなもので、末尾の改行の有無によって、1行多く数えます。
TStream.Column は、a=Split(vbLf & TStream..ReadAll,vbLf): Len(a(UBound(a)))+1 みたいなものです。
なので、改行の後に文字がない場合(TStream.Column=1)、1を減じます(True=-1)。

2008年6月22日 (日)

フレーム構成を表示するコンテキストメニュー拡張

フレームの構成を、

親フレームのURL
子フレームのURL
孫フレームのURL

みたいに、インデントを付けて新規のウィンドウに表示します。

frames.htm

<script language=jscript defer>
var win=window.open("about:blank","_blank");
var doc=win.document;
doc.open("text/html");
doc.writeln('<'+'dl>');
doc.writeln('<'+'dt>'+external.menuArguments.top.location+'<'+'/dt>');
subframes(external.menuArguments.top)
doc.writeln('<'+'/dl>');
doc.close();
doc.title="フレーム構成";

function subframes(frm){
  doc.writeln('<'+'dl>');
  try{
    for(var i=0; i<frm.frames.length; i++){
      doc.writeln('<'+'dt>'+frm.frames(i).location+'<'+'/dt>');
      subframes(frm.frames(i));
    }
  }catch(e){}
  doc.writeln('<'+'/dl>');
}
</script>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\フレーム構成]
@="C:\\どこか\\frames.htm"

2008年6月21日 (土)

IE7でIEの名前が変わりました。

IWebBrowser2.Nameが、
IE6 Microsoft Internet Explorer
から
IE7 Windows Internet Explorer
に変わりました。

もし、IEのタイトルでAppActivateしてたりすると困ります。

エクスプローラの名前は、XP SP3でも、IE6と同じで、変わってません。
ひょっとして、Vistaでは、変わってるかも知れません。。。
と言っても、エクスプローラのタイトルには現れませんが。。。

2008年6月20日 (金)

Vistaの保護モードで、CreateObject("InternetExplorer.Application")を使う。

Vistaの保護モードでは、困ったことに、

Set ie=CreateObject("InternetExplorer.Application")
ie.Visible=True
ie.Navigate "about:blank"
Do While ie.Busy Or ie.ReadyState<>4
  WScript.Sleep 100
Loop

がまともに動かないらしい。

保護モードを解除せずに、これを回避する方法は?
IEを新規に起こすケースが駄目?
既存ならOK?

もし、そうなら、たぶん、これで行けると思うのですが、Vista環境がないので試せません。

と思ったら、新規でも既存でも駄目みたいですね。なら、これならどうだろ?

Set Shell=CreateObject("Shell.Application")
Shell.ShellExecute "iexplore.exe","-embedding"
Do
  For Each ie In Shell.Windows()
    If ie.ReadyState<>0 Then
    ElseIf LCase(Right(ie.FullName,13))="\iexplore.exe" Then
      Exit Do
    End If
  Next
  WScript.Sleep 100
Loop
ie.Visible=True
ie.Navigate "about:blank"
Do While ie.Busy Or ie.ReadyState<>4
  WScript.Sleep 100
Loop

2008年6月19日 (木)

PowerShellでZIP圧縮する。(その2)

IE7に対応。

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

MakeExZIP.ps1 ZIPファイル ファイルやフォルダ...

if($args.length -lt 2){
  write-output "Arguments Missing.";
  write-output "Usage: MakeExZIP.PS1 ZIPfile files...";
  return;
}
if([System.IO.Path]::GetExtension($args[0]) -ne ".zip"){
  write-output ("Invalid Extension Name - " + $args[0]);
  return;
}
$ie = $null;
if([System.IO.File]::Exists($args[0])){
  [void][reflection.assembly]::LoadWithPartialName("'Microsoft.VisualBasic");
#  IE7以降も可
  $Shell=new-object -com Shell.Application;
  $ZIPfile=$Shell.NameSpace([System.IO.Path]::GetFullPath($args[0])).Self.Path;
  $Shell.ShellExecute($ZIPfile,$null,$null,$null,0);
  while($true){
    foreach($ie in $Shell.Windows()){
      if($ie.Visible){}
      elseif([Microsoft.VisualBasic.Information]::TypeName($ie.Document) -like "IShellFolderViewDual*"){
        if($ie.Document.Folder.Self.Path -eq $ZIPfile){break;}
      }
      $ie=$null;
    }
    if($ie){break;}
    Start-sleep -milliseconds 100;
  }
#  $ie=new-object -com InternetExplorer.Application; #IE7以降ダメ
#  $ie=[Microsoft.VisualBasic.Interaction]::GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}"); #IE7以降も可
#  $ie.Navigate([System.IO.Path]::GetFullPath($args[0]));
  while($ie.Busy -or ($ie.ReadyState -ne 4)){
    Start-sleep -milliseconds 100;
  }
  $Shell=$ie.Document.Application;
  $zFolder=$ie.Document.Folder;
}else{
  set-content $args[0] ("PK" + [char]5 + [char]6 + ("$([char]0)" * 18));
  $shell=new-object -com shell.application;
  $zFolder = $Shell.NameSpace([System.IO.Path]::GetFullPath($args[0]));
}
for($k=1;$k -lt $args.length;$k++){
  $File=[System.IO.Path]::GetFileName($args[$k]);
  $sFolder=$Shell.NameSpace([System.IO.Path]::GetFullPath($args[$k])+"\..");
  $sFolderItem=$sFolder.ParseName($File);
  if(-not $sFolderItem){
    write-output ("File Not Found. - " + $File);
    break;
  }
  $zFolderItem=$zFolder.ParseName($File);
  if($zFolderItem){
    if($tFolderName -eq $null){
      $tFolderName = [System.IO.Path]::GetTempFileName();
      [System.IO.File]::Delete($tFolderName);
      [void][System.IO.Directory]::CreateDirectory($tFolderName);
      $tFolder = $Shell.NameSpace(($tFolderName));
    }
    $Count = $zFolder.Items().Count;
    $zFolderItem.InvokeVerb("cut");
    $tFolder.Self.InvokeVerb("paste");
    while($zFolder.Items().Count -eq $Count){
      Start-sleep -milliseconds 1000;
    }
    $zFolderItem = $null;
  }
  $Count = $zFolder.Items().Count;
  $zFolder.CopyHere($sFolderItem);
  while($zFolder.Items().Count -eq $Count){
    Start-sleep -milliseconds 1000;
  }
  $sFolderItem = $null;
}
$tFolder = $null;
$zFolder = $null;
$Shell = $null;
if($ie){$ie.Quit();}
[void][Reflection.Assembly]::LoadWithPartialName("Microsoft.VisualBasic")
while([Microsoft.VisualBasic.Information]::TypeName($ie) -eq "IWebBrowser2"){
  Start-sleep -milliseconds 1000;
}
if($tFolderName){
  [System.IO.Directory]::Delete($tFolderName,$true);
}

2008年6月18日 (水)

PowerShellでZIP展開する。

IE7に対応。

ExtractZIP.PS1 ZIPファイル [展開先フォルダ\][ファイル]...

if($args.length -lt 1){
  write-output "Arguments Missing.";
  write-output "Usage: ExtractZIP.PS1 ZIPfile [folder\][file]...";
  return;
}
if([System.IO.Path]::GetExtension($args[0]) -ne ".zip"){
  write-output ("Invalid Extension Name - " + $args[0]);
  return;
}
if(-not [System.IO.File]::Exists($args[0])){
  write-output ("File Not Found. - " + $args[0]);
  return;
}
[void][reflection.assembly]::LoadWithPartialName("'Microsoft.VisualBasic");
#IE7以降も可
$Shell=new-object -com Shell.Application;
$ZIPfile=$Shell.NameSpace([System.IO.Path]::GetFullPath($args[0])).Self.Path;
$Shell.ShellExecute($ZIPfile,$null,$null,$null,0);
while($true){
  foreach($ie in $Shell.Windows()){
    if($ie.Visible){}
    elseif([Microsoft.VisualBasic.Information]::TypeName($ie.Document) -like "IShellFolderViewDual*"){
      if($ie.Document.Folder.Self.Path -eq $ZIPfile){break;}
    }
    $ie=$null;
  }
  if($ie){break;}
  Start-sleep -milliseconds 100;
}
#$ie=new-object -com InternetExplorer.Application; #IE7以降ダメ
#$ie=[Microsoft.VisualBasic.Interaction]::GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}"); #IE7以降も可
#$ie.Navigate([System.IO.Path]::GetFullPath($args[0]));
while($ie.Busy -or ($ie.ReadyState -ne 4)){
  Start-sleep -milliseconds 100;
}
$Shell=$ie.Document.Application;
$zFolder=$ie.Document.Folder;
if($args.length -eq 1){
  $dFolder=$Shell.NameSpace(([System.Environment]::CurrentDirectory));
  $dFolder.CopyHere(($zFolder.Items()));
}elseif(($arg.length -eq 2) -and $args[1].EndsWith("\")){
  if(-not [System.IO.Directory]::Exists($args[1])){
    write-output ("Folder Not Found. - " + $args[1]);
    return;
  }
  $dFolder=$Shell.NameSpace([System.IO.Path]::GetFullPath($args[1]));
  $dFolder.CopyHere(($zFolder.Items()));
}else{
  for($k=1;$k -lt $args.length;$k++){
    $File=[System.IO.Path]::GetFileName($args[$k]);
    $Folder=[System.IO.Path]::GetDirectoryName($args[$k]);
    if($Folder -ne ""){
      if(-not [System.IO.Directory]::Exists($Folder)){
        write-output ("Folder Not Found. - " + $Folder);
        break;
      }
    }
    $dFolder=$Shell.NameSpace([System.IO.Path]::GetFullPath($args[$k])+"\..");
    $zFolderItem=$zFolder.ParseName($File);
    if(-not $zFolderItem){
      write-output ("File Not Found. - " + $File);
      break;
    }
    $dFolder.CopyHere($zFolderItem);
  }
}
$ie.Quit();

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(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
        Threading.Thread.Sleep(1000)
      Loop
      zFolderItem = Nothing
    End If
    Count = zFolder.Items().Count
    zFolder.CopyHere(sFolderItem)
    Do While zFolder.Items().Count = Count
      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展開用の一時ファイルが残ります。

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(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

2008年6月15日 (日)

ZIPファイルの中身を削除するバッチファイル(その2)

IE7に対応。

DeleteExZIP.CMD ZIPファイル ファイルまたはフォルダ名...

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
var Usage="Usage: DeleteExZIP.CMD ZIPfile files...";
if(WScript.Arguments.Count()<2){
  WScript.Echo(Usage);
  WScript.Quit();
}
var ZIPfile=WScript.Arguments.Item(0);
var fso=new ActiveXObject("Scripting.FileSystemObject");
if(fso.GetExtensionName(ZIPfile).toUpperCase()!="ZIP"){
  WScript.Echo("Invalid Extension Name -",ZIPfile);
  WScript.Quit();
}
if(!fso.FileExists(ZIPfile)){
  WScript.Echo("ZIP file not found. -",ZIPfile);
  WScript.Quit();
}
ZIPfile=fso.GetAbsolutePathName(ZIPfile);
//IE7以降も可
var Shell=new ActiveXObject("Shell.Application");
var Path=Shell.NameSpace(ZIPfile).Self.Path;
Shell.ShellExecute(ZIPfile,null,null,null,0);
x:while(true){
  for(var k=Shell.Windows().Count;k>0;k--){
    var ie=Shell.Windows().Item(k-1);
    if(! ie.Visible && "Folder" in ie.Document && ie.Document.Folder.Self.Path==Path) break x;
  }
  WScript.Sleep(100);
}
//var ie=new ActiveXObject("InternetExplorer.Application");//IE7以降ダメ
//var ie=GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}");//IE7以降も可
//ie.Navigate(ZIPfile);
while(ie.Busy||ie.ReadyState!=4) WScript.Sleep(100);
var Shell=ie.Document.Application;
var zFolder=ie.Document.Folder;
var tFolderName=fso.BuildPath(fso.GetParentFolderName(ZIPfile),fso.GetTempName());
fso.CreateFolder(tFolderName);
var tFolder=Shell.NameSpace(tFolderName);
for(var k=1;k<WScript.Arguments.Count();k++){
  var Path=fso.GetFileName(WScript.Arguments.Item(k));
  var FileName=Path.toLowerCase();
  var zFolderItem=zFolder.ParseName(FileName);
  if(!zFolderItem){
    WScript.Echo(Path,"- Not Found.");
    break;
  }
  var Count=zFolder.Items().Count;
//  tFolder.MoveHere(zFolderItem);
  zFolderItem.InvokeVerb("cut");
  tFolder.Self.InvokeVerb("paste");
  while(zFolder.Items().Count==Count){
//    WScript.Echo(zFolder.Items().Count,Count);
    WScript.Sleep(100);
  }
}
tFolder=undefined;
Shell=undefined;
ie.Quit();
fso.DeleteFolder(tFolderName);
WScript.Quit();

2008年6月14日 (土)

ZIPファイルを展開するバッチファイル

IE7に対応。

ExtractZIP.CMD ZIPファイル [ファイルまたはフォルダ名...]

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
var Usage="Usage: ExtractZIP.CMD ZIPfile [files...]";
if(WScript.Arguments.Count()<1){
  WScript.Echo(Usage);
  WScript.Quit();
}
var ZIPfile=WScript.Arguments.Item(0);
var fso=new ActiveXObject("Scripting.FileSystemObject");
if(fso.GetExtensionName(ZIPfile).toUpperCase()!="ZIP"){
  WScript.Echo("Invalid Extension Name -",ZIPfile);
  WScript.Quit();
}
if(!fso.FileExists(ZIPfile)){
  WScript.Echo("ZIP file not found. -",ZIPfile);
  WScript.Quit();
}
ZIPfile=fso.GetAbsolutePathName(ZIPfile);
//IE7以降も可
var Shell=new ActiveXObject("Shell.Application");
var Path=Shell.NameSpace(ZIPfile).Self.Path;
Shell.ShellExecute(ZIPfile,null,null,null,0);
x:while(true){
  for(var k=Shell.Windows().Count;k>0;k--){
    var ie=Shell.Windows().Item(k-1);
    if(! ie.Visible && "Folder" in ie.Document && ie.Document.Folder.Self.Path==Path) break x;
  }
  WScript.Sleep(100);
}
//var ie=new ActiveXObject("InternetExplorer.Application");//IE7以降ダメ
//var ie=GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}");//IE7以降も可
//ie.Navigate(ZIPfile);
while(ie.Busy||ie.ReadyState!=4) WScript.Sleep(100);
var Shell=ie.Document.Application;
var zFolder=ie.Document.Folder;
if(WScript.Arguments.Count()<2){
  var dFolder=Shell.NameSpace(fso.GetAbsolutePathName(""));
  dFolder.CopyHere(zFolder.Items());
}else if(WScript.Arguments.Count()==2 && WScript.Arguments.Item(1).charAt(WScript.Arguments.Item(1).length-1)=='\\'){
  var dFolder=Shell.NameSpace(fso.GetAbsolutePathName(WScript.Arguments.Item(1)));
  if(dFolder){
    dFolder.CopyHere(zFolder.Items());
  }else{
    WScript.Echo(WScript.Arguments.Item(1),"- Not Found.");
  }
}else{
  for(var k=1;k<WScript.Arguments.Count();k++){
    var FolderName=fso.GetParentFolderName(WScript.Arguments.Item(k));
    var FileName=fso.GetFileName(WScript.Arguments.Item(k));
    var dFolder=Shell.NameSpace(fso.GetAbsolutePathName(FolderName));
    if(!dFolder){
      WScript.Echo(FolderName,"- Not Found.");
      break;
    }
    var zFolderItem=zFolder.ParseName(FileName);
    if(!zFolderItem){
      WScript.Echo(FileName,"- Not Found.");
      break;
    }
    dFolder.CopyHere(zFolderItem);
  }
}
ie.Quit();
WScript.Quit();

2008年6月13日 (金)

ZIPファイルを作成/追加/置換するバッチファイル(その2)

IE7に対応。

MakeExZIP.CMD ZIPファイル名 ファイルまたはフォルダ...

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
var Usage="Usage: MakeExZIP.CMD ZIPfile files...";
if(WScript.Arguments.Count()<2){
  WScript.Echo(Usage);
  WScript.Quit();
}
var ZIPfile=WScript.Arguments.Item(0);
var fso=new ActiveXObject("Scripting.FileSystemObject");
if(fso.GetExtensionName(ZIPfile).toUpperCase()!="ZIP"){
  WScript.Echo("Invalid Extension Name -",ZIPfile);
  WScript.Quit();
}
ZIPfile=fso.GetAbsolutePathName(ZIPfile);
if(fso.FileExists(ZIPfile)){
//IE7以降も可
var Shell=new ActiveXObject("Shell.Application");
var Path=Shell.NameSpace(ZIPfile).Self.Path;
Shell.ShellExecute(ZIPfile,null,null,null,0);
x:while(true){
  for(var k=Shell.Windows().Count;k>0;k--){
    var ie=Shell.Windows().Item(k-1);
    if(! ie.Visible && "Folder" in ie.Document && ie.Document.Folder.Self.Path==Path) break x;
  }
  WScript.Sleep(100);
}
//var ie=new ActiveXObject("InternetExplorer.Application");//IE7以降ダメ
//var ie=GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}");//IE7以降も可
//ie.Navigate(ZIPfile);
  while(ie.Busy||ie.ReadyState!=4) WScript.Sleep(100);
  var Shell=ie.Document.Application;
  var zFolder=ie.Document.Folder;
}else{
  var File=fso.CreateTextFile(ZIPfile,false);
  File.Write("PK" + String.fromCharCode(5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0));
  File.Close();
  var Shell=new ActiveXObject("Shell.Application");
  var zFolder=Shell.NameSpace(ZIPfile);
}
for(var k=1;k<WScript.Arguments.Count();k++){
  var Path=WScript.Arguments.Item(k);
  var FileName=fso.GetFileName(Path).toLowerCase();
  var sFolder=Shell.NameSpace(fso.GetAbsolutePathName(Path)+'\\..\\');
  var sFolderItem=sFolder.ParseName(FileName);
  if(!sFolderItem){
    WScript.Echo(Path,"- Not Found.");
    break;
  }
  var zFolderItem=zFolder.ParseName(FileName);
  if(zFolderItem){
    if(tFolderName==undefined){
      var tFolderName=fso.BuildPath(fso.GetParentFolderName(ZIPfile),fso.GetTempName());
      fso.CreateFolder(tFolderName);
      var tFolder=Shell.NameSpace(tFolderName);
    }
    var Count=zFolder.Items().Count;
    zFolderItem.InvokeVerb("cut");
    tFolder.Self.InvokeVerb("paste");
    while(zFolder.Items().Count==Count){
      WScript.Sleep(100);
    }
  }
  var Count=zFolder.Items().Count;
  zFolder.CopyHere(sFolderItem);
  while(zFolder.Items().Count==Count){
    WScript.Sleep(100);
  }
}
tFolder=undefined;
Shell=undefined;
if(ie) ie.Quit();
if(tFolderName) fso.DeleteFolder(tFolderName);
WScript.Quit();

2008年6月12日 (木)

VBAでZIP展開する。

IE7に対応。

Call ExtractZIP(ZIPファイル,[展開先フォルダ\][ファイル名またはフォルダ名]...)

Option Explicit

Sub ExtractZIP(ZIPfile As String, ParamArray Files() As Variant)
Dim fso As Object
Dim ie As Object
Dim Shell As Object
Dim zFolder As Object
Dim dFolder As Object
Dim Path As Variant
Dim FolderName As String
Dim FileName As String
Dim zFolderItem As Object

Set fso = CreateObject("Scripting.FileSystemObject")
If UCase(fso.GetExtensionName(ZIPfile)) <> "ZIP" Then
  MsgBox "Invalid Extension Name - " & ZIPfile, vbCritical
  Exit Sub
End If
If Not fso.FileExists(ZIPfile) Then
  MsgBox "ZIP file not found. - " & ZIPfile, vbCritical
  Exit Sub
End If
ZIPfile = fso.GetAbsolutePathName(ZIPfile)
'IE7以降も可
Set Shell = CreateObject("Shell.Application")
ZIPfile = Shell.Namespace((ZIPfile)).Self.Path
Shell.ShellExecute 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
  Application.Wait Now + TimeSerial(0, 0, 1)
Loop
'Set ie = CreateObject("InternetExplorer.Application")  'IE7以降ダメ
'Set ie = GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}") 'IE7以降も可
'ie.Navigate ZIPfile
Do While ie.Busy Or ie.ReadyState <> 4
  Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Set Shell = ie.Document.Application
Set zFolder = ie.Document.Folder
If UBound(Files) = -1 Then
  Set dFolder = Shell.Namespace(fso.GetAbsolutePathName(""))
  dFolder.CopyHere zFolder.Items()
ElseIf UBound(Files) = 0 And Right(Files(0), 1) = "\" Then
  Set dFolder = Shell.Namespace(fso.GetAbsolutePathName(Files(0)))
  If dFolder Is Nothing Then
    MsgBox Files(0) & " - Not Found.", vbCritical
  Else
    dFolder.CopyHere zFolder.Items()
  End If
Else
  For Each Path In Files
    FolderName = fso.GetParentFolderName(Path)
    FileName = fso.GetFileName(Path)
    Set dFolder = Shell.Namespace(fso.GetAbsolutePathName(FolderName))
    If dFolder Is Nothing Then
      MsgBox FolderName & " - Not Found.", vbCritical
      Exit For
    End If
    Set zFolderItem = zFolder.ParseName(FileName)
    If zFolderItem Is Nothing Then
      MsgBox FileName & " - Not Found.", vbCritical
      Exit For
    End If
    dFolder.CopyHere zFolderItem
  Next
End If
ie.Quit
End Sub

ZIP展開のFolder.CopyHere()は同期なので、待ち合わせは必要ないけれど、Shell.Applicationだと、展開用の一時フォルダが残るので、Explorer.exeを使います。

2008年6月11日 (水)

フォームの入力データなどが入った、そのとき実行中のソースを表示する。

フォームにデータを入力して、後で見るために、「ソースの表示」や「名前を付けて保存」をしても、取れるのはオリジナルソースで、入力データなどはありません。

そこで、IEのコンテクストメニューを拡張して、新しいウィンドウを作成し、そのとき実行中のソースをテキストとして書き込みます。

フォームの送信前に、ページ上で右クリックして、コンテキストメニューから、「実行中のソースを表示(Z)」を選択します。

ViewHTML.htm

<script language=vbscript defer>
set win=window.open("about:blank","_blank")
set doc=win.document.open("text/plain")
doc.write external.menuArguments.top.document.documentElement.outerHTML
doc.close
doc.charset=external.menuArguments.top.document.charset
doc.title=external.menuArguments.top.document.title & ".txt"
</script>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\実行中のソースを表示(&Z)]
@="C:\\どこか\\ViewHTML.htm"

このソースを表示するウィンドウで「ソースの表示」や「名前を付けて保存」すると、フォームの入力データなどが入ったソースをファイルに取り出せます。

2008年6月10日 (火)

フォームを送信して戻るとフォームの入力データが消える問題を回避する。(その2)

掲示板に書き込んだり、フォームを送信する前に、別のウィンドウにそのページを残す。

掲示板に書き込んだり、フォームを送信するとき、パラメタエラーなどで、前に戻ると入力データが消えていて、再度一から入力し直す、なんてことがあります。

フォームの送信前に CTRL+N または、 [ファイル] - [新規ウィンドウ] (IE7) または、 [ファイル] - [新規作成] - [ウィンドウ] (IE6) すると、新しいウィンドウに同じページが表示されます。
このとき、入力データがコピーされるケースもありますが、消えるケースもあります。

そこで、IEのコンテクストメニューを拡張して、人為的に新しいウィンドウを作成し、ページ内容をコピーします。

フォームの送信前に、ページ上で右クリックして、コンテキストメニューから、「ウィンドウの複製(W)」を選択します。

CopyWindow.htm

<head>
<meta http-equiv="content-type" content="text/html; charset=shift_jis">
<script language=vbscript defer>
set win=window.open(external.menuArguments.top.document.URL,"_blank")
Do While win.document.readyState<>"complete"
'  alert win.document.readyState
Loop
win.document.body.innerHTML=external.menuArguments.top.document.body.innerHTML
win.document.title="複製:" & win.document.title
</script>
</head>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\ウィンドウの複製(&W)]
@="C:\\どこか\\CopyWindow.htm"

こうして複製したウィンドウのタイトルには、元のタイトルの前に「複製:」が付きます。
このページからデータをコピーしたり、印刷するのは構いませんが、送信は、やめておいたほうがよいでしょう。

2008年6月 9日 (月)

フォームを送信して戻るとフォームの入力データが消える問題を回避する。

掲示板に書き込んだり、フォームを送信するとき、パラメタエラーなどで、前に戻ると入力データが消えていて、再度一から入力し直す、なんてことがあります。

リンクを開くときは、シフト+クリックやコンテキストメニューで「新しいウィンドウで開く」ことができます。
しかし、フォームの送信ボタンには、「新しいウィンドウで開く」がありません。

そこで、IEのコンテキストメニューを拡張し、メモリ中のソースを<form target="_blank">のように書き換えます。
これにより、フォーム送信時、現在のページを残して、フォーム送信後を「新しいウィンドウで開く」ことができます。

フォームの送信前に、ページ上で右クリックして、コンテキストメニューから、「ターゲット変更(@)」を選択します。

TargetNew.htm

<object id=sc classid=clsid:0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC>
<param name=language value=vbscript>
<param name=allowui value=true>
</object>
<script language=vbscript defer>
sc.addcode "function messagebox(s,b,t):messagebox=msgbox(s,b,t):end function"
r=sc.run("messagebox",external.menuArguments.top.document.forms.length,vbYesNoCancel+vbDefaultButton2,"Change All Targets ? Y(all) N(prompt) Cancel(none)")
If r<>vbCancel Then
  For Each form In external.menuArguments.top.document.forms
    If r=vbYes Then
      form.target="_blank"
    Else
      Select Case sc.run("messagebox",Join(Array(form.action,form.target,form.outerHTML),vbLf),vbYesNoCancel+vbDefaultButton2,"Change Target ?")
      Case vbYes
        form.target="_blank"
      Case vbCancel
        Exit For
      End Select
    End If
  Next
  If Not IsObject(form) Then call sc.run("messagebox","更新終了",vbOkOnly,"Target Changed.")
End If
</script>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\ターゲット変更(&@)]
@="C:\\どこか\\TargetNew.htm"

そのままでは、MsgBox()が使えないので、ScriptControlの小技を使います。
WScript.ShellのPopUp()も使えたり使えなかったりするので使いません。

2008年6月 8日 (日)

「テキスト ファイル (*.txt)」で「名前を付けて保存」する。

ついでに。

SaveAsTEXT.htm

<html>
<head>
<script language=jscript defer>
var title=external.menuArguments.top.document.title;
if(title==""){
  a1.href=external.menuArguments.top.document.URL;
  title=new ActiveXObject("Scripting.FileSystemObject").GetFileName(decodeURI(a1.pathname));
}
title=title.replace(/[.:\\\/*?<>|"]/g,"_");
external.menuArguments.top.document.execCommand("saveas",true,title+".txt");
</script>
</head>
<body>
<a id=a1 ></a>
</body>
</html>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\テキスト ファイル(&-)]
@="C:\\どこか\\SaveAsFILE.htm"

document.execCommand("SaveAs")で、ファイル名に*.txtを指定しても、
ie.ExecWB(OLECMDID_SAVEAS)で、タイトルに*.txtを指定しても、どちらでもできます。

2008年6月 7日 (土)

ファイル名で「名前を付けて保存」する。

IEで、「名前を付けて保存」すると、デフォルトでタイトル名で保存されます。
これを、ファイル名で保存することはできない?

IE7でShell.Windows().Item()が使えなくなったので、コンテキストメニュー拡張に変更します。

SaveAsFILE.htm

<script language=vbscript defer>
external.menuArguments.top.document.execCommand "saveas"
</script>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\Web ページ、ファイル名(&L)]
@="C:\\どこか\\SaveAsFILE.htm"

document.execCommand("SaveAs") は、旧ダイアログ「HTML ドキュメントの保存」です。
これでファイル名を指定しないと、「名前を付けて保存」と違って、URLからファイル名を生成します。

2008年6月 6日 (金)

「Web アーカイブ、単一のファイル (*.mht)」で「名前を付けて保存」する。

IE7では、「名前を付けて保存」のデフォルトが「Web アーカイブ、単一のファイル (*.mht)」なので、わざわざ作る意味がありませんが、IE6用に。

とは言っても、IE6なら、わざわざコンテキストメニュー拡張にする必要はないのですが。。。

SaveAsMHTML.htm

<html>
<head>
<object id=ShellWindows classid=clsid:9BA05972-F6A8-11CF-A442-00A0C90A8F39></object>
<object id=fso classid=clsid:0D43FE01-F093-11CF-8940-00A0C9054228></object>
<script language=jscript defer></script>
<script language=vbscript defer>
For Each ie In ShellWindows
  If TypeName(ie.Document)="HTMLDocument" Then
    If ie.Document.parentWindow Is external.menuArguments.top Then Exit For
  End If
Next
title=ie.Document.title
If title="" Then
  a1.href=ie.LocationURL
  title=fso.GetFileName(decodeURI(a1.pathname))
End If
Select Case LCase(fso.GetExtensionName(title))
Case "mht","mhtml"
Case Else
  title2=ie.Document.title
  ie.Document.title=title & ".mht"
End Select
ie.ExecWB 4,1
If Not IsEmpty(title2) Then ie.Document.title=title2
</script>
</head>
<body>
<a id=a1 ></a>
</body>
</html>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\Web アーカイブ、単一のファイル(&M)]
@="C:\\どこか\\SaveAsMHTML.htm"

2008年6月 5日 (木)

「Web ページ、完全 (*.htm;*.html)」で「名前を付けて保存」する。

IE7で「名前を付けて保存」のデフォルトが「Web ページ、完全 (*.htm;*.html)」から「Web アーカイブ、単一のファイル (*.mht)」に変わりました。

そのため、IE7で「Web ページ、完全 (*.htm;*.html)」で保存しようとしても、デフォルトが「Web アーカイブ、単一のファイル (*.mht)」なので、これをいちいち変更しなければなりません。面倒臭。

IE7でShell.Windows().Item()が使えなくなったので、コンテキストメニュー拡張に変更します。

SaveAsFILES.htm

<html>
<head>
<object id=ShellWindows classid=clsid:9BA05972-F6A8-11CF-A442-00A0C90A8F39></object>
<object id=fso classid=clsid:0D43FE01-F093-11CF-8940-00A0C9054228></object>
<script language=jscript defer></script>
<script language=vbscript defer>
For Each ie In ShellWindows
  If TypeName(ie.Document)="HTMLDocument" Then
    If ie.Document.parentWindow Is external.menuArguments.top Then Exit For
  End If
Next
title=ie.Document.title
If title="" Then
  a1.href=ie.LocationURL
  title=fso.GetFileName(decodeURI(a1.pathname))
End If
Select Case LCase(fso.GetExtensionName(title))
Case "htm","html"
Case Else
  title2=ie.Document.title
  ie.Document.title=title & ".htm"
End Select
ie.ExecWB 4,1
If Not IsEmpty(title2) Then ie.Document.title=title2
</script>
</head>
<body>
<a id=a1 ></a>
</body>
</html>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\Web ページ、完全(&K)]
@="C:\\どこか\\SaveAsFILES.htm"

document.execCommand("SaveAs") は、旧ダイアログ「HTML ドキュメントの保存」です。
これには、「Web アーカイブ、単一のファイル (*.mht)」や「Web ページ、完全 (*.htm;*.html)」がありません。
ie.ExecWB(OLECMDID_SAVEAS)でも、ファイル名を指定すると、旧ダイアログになります。
なので、ファイル名を指定しないで、ie.ExecWB(OLECMDID_SAVEAS)を使います。
すると、新ダイアログ「Web ページの保存」になります。
新ダイアログは、タイトルからファイル名を生成します。
ここで、もし、タイトルの末尾が.mhtや.htmだと、生成されるファイル名もそうなって、それに応じて「ファイルの種類(T)」が「Web アーカイブ、単一のファイル (*.mht)」や「Web ページ、完全 (*.htm;*.html)」になります。
これを利用します。
ie.ExecWB(OLECMDID_SAVEAS)を使うために、ShellWindowsコレクションの中から自分のIEオブジェクトを探します。

2008年6月 4日 (水)

「Web ページ、HTML のみ (*.htm;*.html)」で「名前を付けて保存」する。

IEで「Web ページ、HTML のみ (*.htm;*.html)」で保存しようとしても、デフォルトが、IE7は「Web アーカイブ、単一のファイル (*.mht)」、IE6は「Web ページ、完全 (*.htm;*.html)」なので、これをいちいち変更しなければなりません。面倒臭。

IE7でShell.Windows().Item()が使えなくなったので、コンテキストメニュー拡張に変更します。

SaveAsHTML.htm

<html>
<head>
<script language=jscript defer>
var title=external.menuArguments.top.document.title;
if(title==""){
  a1.href=external.menuArguments.top.document.URL;
  title=new ActiveXObject("Scripting.FileSystemObject").GetFileName(decodeURI(a1.pathname));
}
title=title.replace(/[.:\\\/*?<>|"]/g,"_");
external.menuArguments.top.document.execCommand("saveas",true,title);
</script>
</head>
<body>
<a id=a1 ></a>
</body>
</html>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\Web ページ、HTML のみ(&H)]
@="C:\\どこか\\SaveAsHTML.htm"

document.execCommand("SaveAs") は、旧ダイアログ「HTML ドキュメントの保存」です。
これでファイル名を指定しないと、「名前を付けて保存」と違って、URLからファイル名を生成します。
なので、コードのほとんどは、「名前を付けて保存」を真似て、タイトルからファイル名を生成するのに苦労しているだけです。:-(
なお、この場合、ie.ExecWB(OLECMDID_SAVEAS)を使っても結局は同じことです。

2008年6月 3日 (火)

IEで表示中のページのタイトルとURLをクリップボードにコピーする。

IE7でShell.Windows().Item()が使えなくなったので、コンテキストメニュー拡張に変更します。

location2clip.htm

<script language=jscript defer>
clipboardData.setData("text",external.menuArguments.top.document.title + "\r\n" + external.menuArguments.top.document.URL);
</script>

レジストリ

[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\URLとタイトルをコピー(&U)]
@="C:\\どこか\\location2clip.htm"

2008年6月 2日 (月)

MSDNのドキュメントエクスプローラの「ソースの表示」エディタを「メモ帳」からエクスプローラに変える。

この設定はIEとは別です。

レジストリの初期状態は以下の設定になっています。

[HKEY_CURRENT_USER\Software\Microsoft\MSDN\7.0\WebBrowser]
"ExtEditor"="%SYSTEMROOT%\\system32\\notepad.exe"

ここを前述のファイルのパスに書き換えます。

ドキュメントエクスプローラには、「~で編集」がないので、IEのように「メモ帳」とエクスプローラの使い分けができません。

そこで、バッチファイルの中身を
explorer /e,/select,%*
notepad.exe %*
の2行にすれば、「メモ帳」とエクスプローラの両方が開きます。

2008年6月 1日 (日)

IEの「ソースの表示」エディタを「メモ帳」からエクスプローラに変える。

「メモ帳」では、サポートしてない文字コードが文字化けするし、さらに「名前を付けて保存」するのも面倒です。
「メモ帳」の代わりにエクスプローラを開いて、キャッシュファイルに位置付ければ、文字化けの心配なく、直にファイルをコピーできます。

そのためには、以下のいずれかのファイルを作成します。

ショートカットファイル
explorer /e,/select,

バッチファイル
explorer /e,/select,%*

そして、レジストリの

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\View Source Editor\Editor Name]
@="C:\\WINDOWS\\system32\\notepad.exe"

を上記のファイルのパスに書き換えます。初期状態は、このキーがありません。

ここには、直接、コマンドラインが書けないので、どこかに上記のファイルが必要です。

なお、IE5.0以降のファイルメニューの「~で編集(D)」やツールバーの「~で編集」ボタンは、「ソースの表示」とは別です。
なので、「~で編集」は「メモ帳」、「ソースの表示」はエクスプローラと使い分けができます。

2008年5月30日 (金)

XP SP3 で WSH が 5.7 になりました。

とは言え、何がどう変わったかのか分かりませんね。障害もそのままだし。:-(

2008年5月29日 (木)

IE7 で Shell と IE が分離されました。(その4)

Shell(Explorer) の場合には、
  Set ie=CreateObject("InternetExplorer.Application")

  Set ie=GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}")
に変えるという対処法ですが、Windows XP Home Edition では駄目かも。

この new:{clsid} プロトコルは、MSMQ の機能です。
MSMQ は、Windows 2000 や Windows XP Pro などのサーバ系 OS には標準装備ですが、Windows XP Home Edition などのクライアント系 OS にはなさそうです。

なので、Windows XP Home Edition では、WSF にして、

<object id="ie" classid="clsid:C08AFD90-F2A1-11D1-8455-00A0C91F3880" />

とするか、レジストリに、

[HKEY_CLASSES_ROOT\Explorer.Application]

[HKEY_CLASSES_ROOT\Explorer.Application\CLSID]
@="{C08AFD90-F2A1-11D1-8455-00A0C91F3880}"

のような ProgID をでっち上げて、

Set ie=CreateObject("Explorer.Application")

で使います。

2008年5月28日 (水)

IE7 で Shell と IE が分離されました。(その3)

そのせいか、IE7 で、「お気に入り」や「リンク」からの起動が制限されました。

IE6 までは、「お気に入り」や「リンク」に、スクリプトや HTA を入れて、IE から起動できましたが、IE7では、ダウンロードのダイアログが出て、更にセキュリティの警告が出て、と大変なことになりました。

で、その対処法ですが、これも難しそうです。
1番目のダウンロードのダイアログは、どこかの設定を変えればよいのかも知れませんが、それには、きっと、セキュリティ上の問題があるのでしょう。
2番目のセキュリティの警告のほうは、署名を付けて、その署名を信頼してやればよいのでしょうが、それも面倒です。

ツールバーの「リンク」の場合は、右クリック、「プログラムから開く(H)」で(大概は、先頭の)アプリを起動します。
「リンク」の場合は、制限されるのは、「開く」だけなので、同じ内容の関連付けを別のキーで作れば、右クリックで起動できます。

エクスプローラバーの「お気に入り」の場合は、打つ手なし。
もし、「お気に入り」の「フォルダのショートカット」を「リンク」の中に作れば、ツールバーの「リンク」の延長で「お気に入り」が使えます。
ただし、再帰の無限ループなど、「フォルダのショートカット」は、トラブルの元だったような。。。
printキーを潰して、印刷の代わりに起動する手もありますが。。。

なので、フォーカスが移ってよいなら、タスクバーから起動するようにするか、どうしてもフォーカスを変えたくなければ、コンテキストメニュー拡張にするしかないでしょう。

2008年5月27日 (火)

IE7 で Shell と IE が分離されました。(その2)

今まで (IE6) は、Shell.ApplicationのWindows().Item() で、現在または最後にアクティブな IE が捕捉できましたが、それができなくなりました。:-(

Shell.ApplicationのWindows().Item() で捕捉できるのは、現在または最後にアクティブな Shell だけです。

それを利用していたスクリプト類は、全滅です。:-(

で、その対処法ですが、難しそうですね。駄目っぽい。

「現に」アクティブな IE の場合には、
  Set ie=CreateObject("Shell.Application").Windows().Item()

  Set Shell=CreateObject("Shell.Application")
  For Each ie In Shell.Windows()
    If TypeName(ie.Document)="HTMLDocument" Then If ie.Document.hasFocus() Then Exit For
  Next
に変えます。
ただし、フォーカスを Web ページ部分に置いておく必要があります。
もし、フォーカスが外れてると、見つけ損ないます。

HTA スクリプトは、フォーカスを奪うので、この手は使えません。

「最後にアクティブ」の部分は、打つ手なし、です。

今まで (IE6) は、これを利用して、ブックマークレットっぽいことが出来ましたが、IE7 ではもう無理みたい。
これからは、コンテキストメニュー拡張でやるしかないかなぁ~。

2008年5月26日 (月)

IE7 で Shell と IE が分離されました。

今まで (IE6) は、IE (IExplore.exe) でフォルダを開いたり、Shell (Explorer.exe) で Web ページを開いたり、相互乗り入れが出来ましたが、それが出来なくなりました。:-(

KB928675 Windows シェルから Internet Explorer 7 の分離

それを利用していたスクリプト類は、全滅です。:-(

で、その対処法ですが、Shell(Explorer)の場合には、
  Set ie=CreateObject("InternetExplorer.Application")

  Set ie=GetObject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}")
に変えます。

VBAなどでは、
  C:\WINDOWS\system32\shdocvw.dll
  Microsoft Internet Controls
を参照設定して、
  Dim ie As SHDocVw.ShellBrowserWindow
  Set ie = New SHDocVw.ShellBrowserWindow
を使います。

これは、まだ、対処法があるのでよいけれど。。。

2008年5月25日 (日)

未初期化の配列を空の配列のように扱うUBound()の代替関数

Option Base {0|1}にも対応します。

Function UpperBound(a)
UpperBound = UBound(Array())
On Error Resume Next
UpperBound = UBound(a)
End Function

または、

Function UpperBound(a, Optional n = 1)
UpperBound = UBound(Array())
On Error Resume Next
UpperBound = UBound(a, n)
End Function

2008年5月24日 (土)

Scripting.Dictionary を配列の代わりに使う。(補足)

配列の代用として使う場合は、インデックスの抜けを避けて使います。

もし、抜けがある場合は、追加インデックスに a.Keys()(a.Count-1)+1 を使います。

a.Add a.Keys()(a.Count - 1) + 1, f

または、

a.Item(a.Keys()(a.Count - 1) + 1) = f

ただし、これは、a.Count=0 のときに、エラーになるので、

If a.Count Then k = a.Keys()(a.Count - 1) + 1 Else k = 0

2008年5月23日 (金)

VBA関数を呼び出すだけの構文は?

LBound()は、VBScriptではグローバルオブジェクトのメソッドなので、
  Call LBound(a)
で呼べますが、VBAではVBA関数なので?、Callだとエラーになります。
  r = LBound(a)
なら、よいようですが、ダミー変数が必要です。
  If LBound(a) Then:
これなら、ダミー変数は不要です。VBA/VBScript共通に使える構文です。

2008年5月22日 (木)

VBScriptやVBAの配列が初期化されているか? 配列の次元数は?

VBScriptやVBAでは、以下のようにLBound()のエラーを拾う。のが普通のやり方みたいです。

Function NumberOfDimensions(a)
NumberOfDimensions = -1
On Error Resume Next
Do
  NumberOfDimensions = NumberOfDimensions + 1
  If LBound(a, NumberOfDimensions + 1) Then:
Loop Until Err
End Function

ここで、次元数=0が、「配列が初期化されてない。」の意味です。

ところで、JScriptには、そういうメソッドがあります!えっ?

Function NumberOfDimensions(a)
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
sc.AddCode "function NumberOfDimensions(a){return new VBArray(a).dimensions();}"
NumberOfDimensions = sc.CodeObject.NumberOfDimensions(a)
End Function

2008年5月21日 (水)

VBAの配列に不定数の要素を追加するには?(その4)

空の配列も、未初期化の配列も、エラーハンドリングも使わないで、なぜか、逆説的に、デクレメントやEraseを使う方法です。

Dim a() As String
Dim f As String
ReDim a(0)
f = Dir("*")
Do While Len(f)
  a(UBound(a)) = f
  ReDim Preserve a(UBound(a) + 1)
  f = Dir()
Loop
If UBound(a) Then
  ReDim Preserve a(UBound(a) - 1)
Else
  Erase a
End If
MsgBox Join(a, vbLf)

これも、要素がないと、後で使うときにエラーになるので、要素が必ず存在するような場合に使うとよいでしょう。

或いは、配列の最後に空の要素を余分に持つというコンベンションにすれば、デクレメントやEraseは不要です。
For k = 0 To UBound(a) - 1
で回す。とか、
Join(a, vbLf)
で末尾にも改行が付いて、これはこれで便利です。

2008年5月20日 (火)

VBAの配列に不定数の要素を追加するには?(その3)

Variant型の空の配列は、
  Dim a As Variant
  a = Array()
で作れますが、Variant型以外のデータ型の場合は?

String型は、
  Dim a() As String
  a = Split("")
Byte型は、
  Dim a() As Byte
  a = ""
で作れますが、Long型などは、空の配列が作れません。

もし、空の配列の代わりに、未初期化の配列を使うと、UBound(a)がエラーになります。

そこで、空の配列の代わりに、未初期化の配列を使うやり方。

Dim a() As String
Dim n As Long
Dim f As String
f = Dir("*")
Do While Len(f)
  n = -1
  On Error Resume Next
  n = UBound(a)
  On Error GoTo 0
  ReDim Preserve a(n + 1)
  a(UBound(a)) = f
  f = Dir()
Loop
MsgBox Join(a, vbLf)

さすがに手順がちょっと多いので、別にPush関数を作ってやるほうがよいでしょう。

Dim a() As String
Dim f As String
f = Dir("*")
Do While Len(f)
  Push a, f
  f = Dir()
Loop
MsgBox Join(a, vbLf)

Sub Push(Items, Item)
Dim n As Long
n = -1
On Error Resume Next
n = UBound(Items)
On Error GoTo 0
ReDim Preserve Items(n + 1)
Items(UBound(Items)) = Item
End Sub

ただし、未初期化のままだと、後で使うときにエラーになるので、要素が必ず存在するような場合に使うとよいでしょう。

なので、要素がないこともあるときは、空の配列が作れるデータ型なら、それで。
空の配列が作れないデータ型なら、できればVaiant型にしたほうがよいでしょう。

2008年5月19日 (月)

VBScriptやVBAの配列に不定数の要素を追加するには?(その2)

Scripting.Dictionaryを配列の代わりに使います。

Dim a As Object
Dim f As String
Set a = CreateObject("Scripting.Dictionary")
f = Dir("*")
Do While Len(f)
  a.Add a.Count, f
'または、好みで、
'  a.Item(a.Count) = f
  f = Dir()
Loop
MsgBox Join(a.Items(), vbLf)

push()メソッド同様に1行で書けます。

配列の代わりにScripting.Dictionaryを使うときのポイントは、
Dictionaryのキーにインデックス(0~)を使います。
配列でUBound(a)+1と書く代わりにDictionaryでa.Countを使います。
配列でa(k)と書く代わりに、Dictionaryでa.Item(k)と書きます。
Dictionaryがa.Items()で配列になります。
For Each k In aで取り出せるのはキー。a.Item(k)で値。
For Each x In a.Items()で値。

2008年5月18日 (日)

VBScriptやVBAの配列に不定数の要素を追加するには?

例えば、VBAのDir()関数でファイルを列挙して配列に格納するには、

Dim a As Variant
Dim f As String
a = Array()
f = Dir("*")
Do While Len(f)
  ReDim Preserve a(UBound(a) + 1)
  a(UBound(a)) = f
  f = Dir()
Loop
MsgBox Join(a, vbLf)

JScriptならArrayオブジェクトのpush()メソッドで簡単なのですが、VBScriptやVBAの配列では2行になります。

もし、push()メソッド相当のPush関数を別に作ってやれば、1行になります。

Dim a As Variant
Dim f As String
a = Array()
f = Dir("*")
Do While Len(f)
  Push a, f
  f = Dir()
Loop
MsgBox Join(a, vbLf)

Sub Push(Items, Item)
ReDim Preserve Items(UBound(Items) + 1)
Items(UBound(Items)) = Item
End Sub

ここでは、空の配列を作るために、Array()を使用しているので、使えるのは、Variant配列だけです。:-(

2008年5月17日 (土)

VBScriptやVBAからJScriptのArrayオブジェクトのインデックスアクセス(その3)

ラッパ関数を介して、インデックスアクセスするのが、お勧めです。

Set sc=CreateObject("ScriptControl")
sc.Language="JScript"
sc.AddCode "function set(a,k,v){a[k]=v;}function get(a,k){return a[k];}"

参照は、
  x=a[k]
の代わりに、
  x=sc.CodeObject.get(a,k)
または、
  x=sc.Run("get",a,k)

設定は、
  a[k]=x
の代わりに、
  call sc.CodeObject.set(a,k,x)
または、
  call sc.Run("set",a,k,x)

性能は、o(n)なので、n=a.length が大きくても、使えます。

また、Run()よりCodeObjectのほうが速くてよいでしょう。

2008年5月16日 (金)

VBScriptやVBAからJScriptのArrayオブジェクトのインデックスアクセス(その2)

slice()/splice()を使って、見た目、スマートにインデックスアクセスできます。でも、隠れメタボかも?

参照は、
  x=a[k]
の代わりに、
  x=a.slice(k,k+1).pop()

設定は、
  a[k]=x
の代わりに、
  call a.splice(k,1,x)

ただし、性能は、o(n**2)なので、n=a.length が大きいときは使わないほうがよいでしょう。

2008年5月15日 (木)

VBScriptやVBAからJScriptのArrayオブジェクトのインデックスアクセス

VBScriptの配列は、a(k)でインデックスアクセスします。
一方、JScriptのArrayオブジェクトは、JScriptで、a[k]でインデックスアクセスします。
では、JScriptのArrayオブジェクトを、VBScriptやVBAで、どうやってインデックスアクセスするか?

既存のインデックスなら、プロパティとして、a.[0]でアクセスできますが。。。

参照は、
  x=a[k]
の代わりに、
  x=Eval("a.[" & k & "]")
また、VBAなら、
  x = CallByName(a, k, VbGet)

設定は、
  a[k]=x
の代わりに、
  Execute "a.[" & k & "]=x"

しかし、EvalやExecuteは使いにくいですね。新規のインデックスにも使えないし。

2008年5月14日 (水)

JScriptのArrayオブジェクトからの取り出し(pop/shift)の代替

取り出し(pop/shift)は遅いので、For Eachで列挙するのが速くてよいでしょう。

Set sc=CreateObject("ScriptControl")
sc.Language="JScript"
set a=sc.Eval("new Array()")
t1=Timer
For k=1 To 1024*512
  a.push k
Next
MsgBox Timer-t1
'10.35156

t1=Timer
For Each x In a
Next
MsgBox Timer-t1
'0.3046875

もし、インデクスで取り出したければ、For Eachで配列に転写するか、Evalを使うとよいでしょう。

t1=Timer
redim b(a.length-1)
k=-1
For Each x In a
  k=k+1
  b(k)=x
Next
MsgBox Timer-t1
'1.210938

t1=Timer
For k=1 To a.Length
  x=Eval("a.[" & k-1 & "]")
Next
MsgBox Timer-t1
'13.78906

VBAの場合は、CallByName()も使えます。

t1 = Timer
For k = 1 To CallByName(a, "length", VbGet)
  x = CallByName(a, k - 1, VbGet)
Next
Debug.Print Timer - t1
'1.8125

2008年5月13日 (火)

JScriptのArrayオブジェクトからの取り出し(pop/shift)は、ともに遅い。

JScriptのArrayオブジェクトから取り出すとき、pop()も遅いが、shift()はもっと遅い。

Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Set a = sc.Eval("new Array()")
t1 = Timer
For k = 1 To 1024 * 16
  a.push k
Next
MsgBox Timer - t1
'0.28125

t1 = Timer
For k = 1 To a.length
  x = a.pop()
Next
MsgBox Timer - t1
'23.76172

t1 = Timer
For k = 1 To a.length
  x = a.shift()
Next
MsgBox Timer - t1
'101.3867

pop()も、shift()も、共にo(n**2)みたい。

より遅いshift()は、使わないほうがよいかも。
もし、必要なら、reverse()とpop()で代替したほうがよいでしょう。

2008年5月12日 (月)

JScriptのArrayオブジェクトへの追加では、unshift()が遅い。

JScriptのArrayオブジェクトに追加するとき、push()はそれほどでもないが、unshift()はとても遅い。

t1 = Timer
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Set a = sc.Eval("new Array()")
For k = 1 To 1024 * 512
  a.push k
Next
MsgBox Timer - t1
'9.523438

push()は、VBScriptやVBAの配列をReDimで漸増するより速いので、その代替に使えます。

t1 = Timer
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Set a = sc.Eval("new Array()")
For k = 1 To 1024 * 8
  a.unshift k
Next
MsgBox Timer - t1
'5.617188

unshift()は、怖ろしく遅いので使うべきでないかも。

push()は、o(n)だけど、unshift()は、o(n**2)みたい。

もし、必要なら、push()とreverse()で代替したほうがよいでしょう。

2008年5月11日 (日)

VBScriptの配列は、漸増が遅い。

VBScriptの配列をReDimで伸縮するとき、漸減はそれほどでもないが、漸増はとても遅い。

t1 = Timer
ReDim a(1024 * 512)
For k = 1024 * 512 To 1 Step -1
  ReDim Preserve a(k - 1)
Next
MsgBox Timer - t1
'1.011719

t1 = Timer
a = Array()
For k = 1 To 1024 * 512
  ReDim Preserve a(k)
Next
MsgBox Timer - t1
'31.84375

束で増やすようにすれば、それなりに速くなります。
もし最大値が予想できるなら、最初にどんと大きく作って、最後に小さく調整するとよいでしょう。

2008年5月 8日 (木)

VBScriptやVBAのSplit()関数の代替にJScriptを使う。

ScriptControl経由でJScriptのStringオブジェクトのsplit()メソッドを使う。

split()メソッドの結果は、JScriptのArrayオブジェクトなので、これをVBScriptの配列に変換します。

a=String(1024*1024,"a")
t1=Timer
Set sc=CreateObject("ScriptControl")
sc.Language="JScript"
sc.AddCode "function split(s,p){return s.split(p);}"
set b=sc.CodeObject.split(a,"a")
Dim c()
ReDim c(b.length-1)
k=0
For Each d In b
  c(k)=d
  k=k+1
Next
MsgBox Timer-t1
'4.148438

For Eachで使う分には、VBScriptの配列にする必要はなく、JScriptのArrayオブジェクトのまま使えば、もっと速い。

a=String(1024*1024,"a")
t1=Timer
Set sc=CreateObject("ScriptControl")
sc.Language="JScript"
sc.AddCode "function split(s,p){return s.split(p);}"
b=sc.CodeObject.split(a,"a")
MsgBox Timer-t1
' 1.609375

JScriptのArrayオブジェクトのまま使うのが、お勧めです。

VBScriptの配列にするなら、代替関数のほうがよいでしょう。

2008年5月 7日 (水)

VBScriptやVBAのSplit()関数の代替関数

代替関数のほうが、速い。とは、情けない。

a = String(1024 * 1024,"a")
t1 = Timer
b = Splitx(a, "a")
MsgBox Timer - t1
' 7.492188

Function Splitx(s, p)
Dim a(), n, b, e, f
ReDim a(Len(s))
b = 1
n = 0
f = InStr(b, s, p)
Do While f
  a(n) = Mid(s, b, f - b)
  n = n + 1
  b = f + Len(p)
  f = InStr(b, s, p)
Loop
a(n) = Mid(s, b)
ReDim Preserve a(n)
Splitx = a
End Function

2008年5月 6日 (火)

VBScriptやVBAのSplit()関数も、チョー遅い!

Split()関数もReplace()