文字列中の異文字を16進表示する関数(VB.NET)

VB.NETに焼き直して、

Public Class Class1
Public Shared Sub Main()
Dim s = "あｱabc" & Chr(10) & ChrW(128)
MsgBox(xString(s))
End Sub

Private Shared Function xString(ByVal s As String) As String
Dim x As String = ""
For k As Integer = 1 To Len(s)
  Dim c = Mid(s, k, 1)
  If 31 < AscW(c) AndAlso AscW(c) < 128 Then
  ElseIf &Hff60 < AscW(c) And AscW(c) < &Hffa0 Then
  ElseIf Chr(Asc(c)) = c And Asc(c) < 0 Then
  Else
    c = Hex(AscW(c))
    c = "{" & New String("0"c, Len(c) Mod 2) & c & "}"
  End If
  x = x & c
Next
Return x
End Function
End Class

文字列中の異文字を16進表示する関数(VBA)

VBAに焼き直して、

Sub a()
s = "あｱabc" & Chr(10) & ChrW(128)
Debug.Print xString(s)
End Sub

Function xString(ByVal s As String) As String
Dim k As Long, c As String
For k = 1 To Len(s)
  c = Mid(s, k, 1)
  If 31 < AscW(c) And AscW(c) < 128 Then
  ElseIf &Hff60 < AscW(c) And AscW(c) < &Hffa0 Then
  ElseIf Chr(Asc(c)) = c  And Asc(c) < 0 Then
  Else
    c = Hex(AscW(c))
    c = "{" & String(Len(c) Mod 2, 48) & c & "}"
  End If
  xString = xString & c
Next
End Function

文字列中の異文字を16進表示する関数(VBScript)

文字列中に変な文字があっても、見た目では分からない場合があります。
VBScriptやJScriptなら、escape()してみれば分かりますが、VBAやVB.NETなどではどうするか？

まず、VBScriptで、
文字列中の異文字(ASCII、半角カタカナ、JIS X 0208、以外)を16進表示に変える関数
を作って、

s="あｱabc" & chr(10) & chrw(128)
msgbox xString(s)

Function xString(s)
Dim k,c
For k=1 To Len(s)
  c=Mid(s,k,1)
  If 31<AscW(c) And AscW(c)<128 Then
  ElseIf &Hff60<AscW(c) And AscW(c)<&Hffa0 Then
  ElseIf Chr(Asc(c))=c And Asc(c)<0 Then
  Else
    c=Hex(AscW(c))
    c="{" & String(Len(c) Mod 2,48) & c & "}"
  End If
  xString=xString & c
Next
End Function

バイナリファイルを16進数でダンプする。(その２)

Byte配列を使わないようにして、JScriptにして、バッチファイルにラップすると、

HexDump.CMD ファイル

@if(0)==(0) ECHO OFF
CScript.exe //NoLogo //E:JScript "%~f0" %*
GOTO :EOF
@end
var adTypeBinary=1;
var adTypeText=2;
var bStream=new ActiveXObject("ADODB.Stream");
bStream.Open();
bStream.Type=adTypeBinary;
bStream.LoadFromFile(WScript.Arguments.Item(0));
var tStream=new ActiveXObject("ADODB.Stream");
tStream.Open();
tStream.Type=adTypeText;
tStream.WriteText(String.fromCharCode(0));
tStream.Position=0;
tStream.Type=adTypeBinary;
tStream.Position=2;
var z=tStream.Read(1);
tStream.Position=2;
for(var Pos=0;Pos<bStream.Size;Pos++){
  bStream.CopyTo(tStream,1);
  tStream.Write(z);
}
tStream.Position=0;
tStream.Type=2;
for(var Pos=0;Pos*2+2<tStream.Size;Pos+=16){
  WScript.StdOut.Write(Pos.toString(16));
  var Bytes=tStream.ReadText(16);
  var Chars="";
  for(var k=0;k<16;k++){
    if(k%4==0) WScript.StdOut.Write(" ");
    if(k<Bytes.length){
      var h=Bytes.charCodeAt(k).toString(16);
      if(h.length<2) WScript.StdOut.Write("0");
      WScript.StdOut.Write(h);
      var h=Bytes.charCodeAt(k);
      if(h<32) h=32;
      Chars+=String.fromCharCode(h);
    }else{
      WScript.StdOut.Write("  ");
    }
  }
  WScript.StdOut.WriteLine(" " + Chars);
}

バイナリファイルを16進数でダンプする。

昔、DUMPコマンドがあったような。。。

cscript HexDump.VBS ファイル

Option Explicit
Dim Stream
Dim Pos
Dim Bytes
Dim Chars
Dim c
Dim k
Set Stream=CreateObject("ADODB.Stream")
Stream.Open
Stream.Type=1
Stream.LoadFromFile WScript.Arguments.Item(0)
For Pos=0 To Stream.Size-1 Step 16
  WScript.StdOut.Write Hex(Pos)
  Bytes=Stream.Read(16)
  Chars=""
  For k=1 To 16
    If k Mod 4 = 1 Then WScript.StdOut.Write " "
    If k>LenB(Bytes) Then
      WScript.StdOut.Write "  "
    Else
      WScript.StdOut.Write Mid(Hex(256+AscB(MidB(Bytes,k,1))),2)
      c=AscB(MidB(Bytes,k,1))
      If c < 32 Then c=32
      Chars=Chars & Chr(c)
    End If
  Next
  WScript.StdOut.WriteLine " " & Chars
Next

本来なら、JScriptにして、バッチファイルにラップするところですが、JScriptからはByte配列が扱えないようで、断念しました。

ショートカットにドロップすると、引数と作業フォルダの環境変数が置換されない。(障害？)

ショートカットのターゲットパスと引数と作業フォルダには、環境変数が書けて、普通に起動すると、置換されるのですが、なぜか、ドロップしたときには、このうち、引数と作業フォルダの環境変数だけが置換されません。

これを利用すれば、普通に起動した場合と、ドロップした場合を区別できますが、使い道が思い浮かばない。。。

それより、回避方法は？

リンク先を

CMD.EXE /C START "" /D 作業フォルダ ターゲットパス 引数

にすれば、一応は回避できますが。。。

ウィンドウアプリから非表示のコンソールウィンドウを開く。(その３)

SW_HIDEで非表示のコンソールウィンドウを開いて、それをAttachConsole()するサンプル。

vbc /t:winexe sample3.vb

Imports System.Diagnostics
Imports System.Threading

Public Class Class1

Private Declare Function AttachConsole Lib "kernel32" (dwProcessId As Integer) As Integer
Private Declare Function AllocConsole Lib "kernel32" () As Integer
Private Declare Function FreeConsole Lib "kernel32" () As Integer

Private Structure KEY_EVENT_RECORD
Dim bKeyDown As Integer
Dim wRepeatCount As Short
Dim wVirtualKeyCode As Short
Dim wVirtualScanCode As Short
Dim UnicodeChar As Short
Dim dwControlKeyState As Integer
End Structure

Private Structure INPUT_RECORD
Dim EventType As Short
Dim KeyEvent As KEY_EVENT_RECORD
End Structure

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Integer) As Integer
Private Declare Function WriteConsoleInput Lib "kernel32" Alias "WriteConsoleInputW" (ByVal hConsoleInput As Integer, ByVal lpBuffer() As INPUT_RECORD, ByVal nLength As Integer, ByRef lpNumberOfEventsWritten As Integer) As Integer

Private Const KEY_EVENT As Integer = 1s
Private Const STD_INPUT_HANDLE As Integer = -10

Public Shared Sub Main()
Dim oProcess As New Process()
oProcess.StartInfo.FileName = "cmd"
oProcess.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
oProcess.Start()
Thread.Sleep(100)
Do While AttachConsole(oProcess.Id) = 0
  AllocConsole()
  FreeConsole()
  Thread.Sleep(100)
Loop
KeyIn("exit" + vbCr)
oProcess.WaitForExit()
MsgBox(CreateObject("WScript.Shell").Exec("fc.exe").StdErr.ReadAll())
End Sub

Private Shared Sub KeyIn(s As String)
Dim lpBuffer() As INPUT_RECORD
Dim lpNumberOfEventsWritten As Integer
Dim hConsoleInput As Integer = GetStdHandle(STD_INPUT_HANDLE)
ReDim lpBuffer(Len(s)*2-1)
For k As Integer = 0 To UBound(lpBuffer)
  lpBuffer(k).EventType = KEY_EVENT
  lpBuffer(k).KeyEvent.bKeyDown = (k + 1) Mod 2
  lpBuffer(k).KeyEvent.wRepeatCount = 0
  lpBuffer(k).KeyEvent.wVirtualScanCode = 0
  lpBuffer(k).KeyEvent.wVirtualKeyCode = 0
  lpBuffer(k).KeyEvent.UnicodeChar = AscW(Mid(s,1 + (k \ 2),1))
  lpBuffer(k).KeyEvent.dwControlKeyState = 0
Next
WriteConsoleInput(hConsoleInput, lpBuffer, UBound(lpBuffer)+1, lpNumberOfEventsWritten)
End Sub
End Class

SW_HIDEで作った非表示のコンソールウィンドウはShowWindow()で再表示できます。

コンソールアプリでは、WaitForInputIdle()が使えません。
なので、代わりに、AttachConsole()をリトライループします。
このとき、AttachConsole()のエラーをリセットするために、AllocConsole()＋FreeConsole()します。

CMD.EXEを終了するために、exit{Enter}をWriteConsoleInput()します。
コードの大部分は、このための処理です。
もし、面倒なら、横着ですが、Process.Kill()すれば、簡単に終了できます。

ウィンドウアプリから非表示のコンソールウィンドウを開く。(その２)

CreateNoWindowで非表示のコンソールウィンドウを開いて、それをAttachConsole()するサンプル。

vbc /t:winexe sample2.vb

Imports System.Diagnostics
Imports System.Threading

Public Class Class1

Private Declare Function AttachConsole Lib "kernel32" (dwProcessId As Integer) As Integer

Public Shared Sub Main()
Dim oProcess As New Process()
oProcess.StartInfo.FileName = "cmd"
oProcess.StartInfo.UseShellExecute = False
oProcess.StartInfo.CreateNoWindow = True
oProcess.StartInfo.RedirectStandardInput = True
oProcess.StartInfo.RedirectStandardOutput = True
oProcess.Start()
oProcess.StandardOutput.ReadLine()
AttachConsole(oProcess.Id)
oProcess.StandardInput.Close()
oProcess.WaitForExit()
MsgBox(CreateObject("WScript.Shell").Exec("fc.exe").StdErr.ReadAll())
End Sub
End Class

CreateNoWindowで作った非表示のコンソールウィンドウはShowWindow()で再表示できないようです。

コンソールアプリでは、WaitForInputIdle()が使えません。
なので、代わりに、StandardOutput.ReadLine()で待ちます。

CMD.EXEを終了するために、StandardInput.Close()します。

ウィンドウアプリから非表示のコンソールウィンドウを開く。

ウィンドウアプリでAllocConsole()すると、コンソールウィンドウが開きます。
このコンソールウィンドウを非表示にできないでしょうか？

一度、表示してから非表示にしてよいなら、

ShowWindow(GetConsoleWindow(),SW_HIDE)

で、できますが、最初から非表示にできない？

もし、ウィンドウアプリを非表示で起動していればそうなりますが。。。

ウィンドウアプリからCMD.EXEを非表示で起動して、そのコンソールウィンドウをAttachConsole()することで代替できます。

ポイントは、
非表示の指定方法(SW_HIDE or CREATE_NO_WINDOW)
AttachConsole()のタイミングの取り方(WaitForInputIdle代替 or StandardOutput.ReadLine)
CMD.EXEの終了のさせ方(WriteConsoleInput or StandardInput.Close)
の３つです。

まず、一瞬コンソールが表示されるサンプルから。

vbc /t:winexe sample1.vb

Imports System.Threading

Public Class Class1

Private Declare Function AllocConsole Lib "kernel32" () As Integer
Private Declare Function GetConsoleWindow Lib "kernel32" () As Integer
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Integer, ByVal nCmdShow As Short) As Integer

Private Const SW_HIDE As Short = 0s
Private Const SW_SHOW As Short = 5s

Public Shared Sub Main()
AllocConsole()
Dim hwnd As Integer = GetConsoleWindow()
ShowWindow(hwnd, SW_HIDE)
Thread.Sleep(5000)
ShowWindow(hwnd, SW_SHOW)
Thread.Sleep(5000)
End Sub
End Class

.NETオブジェクトのオーバロードされたメソッドのサフィックスを調べる。

System.Text.StringBuilderなどの一部の.NETオブジェクトは、スクリプトなどから使えます。
しかし、オーバロードされたメソッドの呼び出しは、自動的には解決されません。
スクリプトからサフィックスで区別して呼び出す必要があります。
しかし、そのサフィックスはどうやって調べるのか？

ListMethods.exe 型名

ListMethods.exe system.text.stringbuilder

vbc ListMethods.VB

Imports System.Reflection
Imports System.Text
Imports System.Collections
Imports System
Imports Microsoft.VisualBasic

Public Class Class1
Public Shared Sub Main(ByVal Args() As String)
If Args.Length<>1 Then
  Console.WriteLine("Usage: ListMethods typename")
  Exit Sub
End If
Dim oType As Type = Type.GetType(Args(0),False,True)
If oType Is Nothing Then
  Console.WriteLine("Name not found - {0}",Args(0))
  Exit Sub
End If
Dim sList As SortedList = New SortedList
For Each Method As MethodInfo In oType.GetMethods()
  Dim sb As StringBuilder = New StringBuilder
  sb.Append(Method.Name)
  If sList.Contains(Method.Name) Then
    sb.Append("_")
    sb.Append(sList.Item(Method.Name).Count + 1)
  End If
  sb.Append("(")
  Dim pCount As Integer = 0
  For Each Parameter As ParameterInfo In Method.GetParameters()
    If pCount > 0 Then sb.Append(", ")
    If Parameter.IsOptional Then sb.Append("Optional ")
    sb.Append(Parameter.Name + " As " + Parameter.ParameterType.ToString())
    If Not IsDBNull(Parameter.DefaultValue.ToString()) AndAlso Parameter.DefaultValue.ToString().Length Then
      sb.Append(" = " + Parameter.DefaultValue.ToString())
    End If
    pCount += 1
  Next
  sb.Append(")")
  If Method.ReturnType.ToString()<>"System.Void" Then
    sb.Append(" As " + Method.ReturnType.ToString())
  End If
  If sList.Contains(Method.Name) Then
    sList.Item(Method.Name).Add(sb.ToString())
  Else
    Dim aList As ArrayList = New ArrayList
    aList.Add(sb.ToString())
    sList.Add(Method.Name,aList)
  End If
Next
For Each aList As ArrayList In sList.Values
  For Each Item As String In aList
    Console.WriteLine(Item)
  Next
Next
End Sub
End Class

コンソールで一部の文字列の文字色と背景色を変えるEchoコマンド拡張

EchoX.exe 文字色 背景色 文字列 [文字色 背景色 文字列]...

文字色と背景色は、数字または名前で指定します。

0 Black
1 DarkBlue
2 DarkGreen
3 DarkCyan
4 DarkRed
5 DarkMagenta
6 DarkYellow
7 Gray
8 DarkGray
9 Blue
10 Green
11 Cyan
12 Red
13 Magenta
14 Yellow
15 White

vbc EchoX.VB

Public Class Class1
Public Shared Sub Main(ByVal Args() As String)
If Args.Length = 0 OrElse Args.Length Mod 3 Then
  Console.WriteLine("Usage: EchoX ForegroundColor BackgroundColor String [F B S]...")
  For Each ColorName As String In ConsoleColor.GetNames(GetType(ConsoleColor))
    Console.WriteLine("{0,2} {1}", [Enum].Format(GetType(ConsoleColor), CType([Enum].Parse(GetType(ConsoleColor), ColorName), ConsoleColor), "d"), ColorName)
  Next
  Exit Sub
End If
Try
  For k As Integer =0 To UBound(Args) Step 3
    Console.ForegroundColor = CType([Enum].Parse(GetType(ConsoleColor), Args(k), True), ConsoleColor)
    Console.BackgroundColor = CType([Enum].Parse(GetType(ConsoleColor), Args(k+1), True), ConsoleColor)
    Console.Write(Args(k+2))
  Next
  Console.ResetColor()
Catch
  Console.ResetColor()
  Console.Error.WriteLine("Source" & vbTab & vbTab & Err.Source & vbLf & "Number" & vbTab & vbTab & Err.Number & vbLf & "Description" & vbTab & Err.Description & vbLf & "DLL Error" & vbTab & vbTab & Err.LastDLLError)
End Try
End Sub
End Class

文字列に空白を含むときは、""で囲みます
その中に更に"を含むときは、\"でエスケープします。
このとき、偶数番目の"から奇数番目の"までの間は、CMD.EXEの制御文字^&|<>)を^でエスケープする必要があります。

行末の改行はありません。

コンソールコマンドを実行して、そのコンソールログを採取するコマンドをVB.NETで作る(その２)

使用法は、

ConCopyX.exe [コマンドライン] >ファイル  (上書き)

ConCopyX.exe [コマンドライン] >>ファイル (追加書き)

ファイルに保存するときは、標準出力をリダイレクトします。
上書きか、追加書きかは、リダイレクションで指定します。

コマンドラインを省略すると、CMDを実行します。
つまり、サブシェルのコマンドプロンプトになります。
このときは、Exitでサブシェルを終了します。

コマンドラインの起動から終了までのコンソールログが標準出力に書き込まれます。

ただし、コンソールログの採取は、コマンドラインの実行と並行して行われるので、
コマンドの出力が多くて、速いと、ログの採取が間に合わず、抜けることがあります。
なので、コマンドプロンプトのプロパティで「画面バッファのサイズ」の「高さ」を十分大きくしておきます。

ConCopyX.exe >ファイル
～～～
～～～
～～～
Exit

コンソールコマンドを実行して、そのコンソールログを採取するコマンドをVB.NETで作る

vbc ConCopyX.VB

Imports System.Diagnostics
Imports System.Threading

Public Class Class1

Private Structure COORD
Dim x As Short
Dim y As Short
End Structure

Private Structure SMALL_RECT
Dim Left As Short
Dim Top As Short
Dim Right As Short
Dim Bottom As Short
End Structure

Private Structure CONSOLE_SCREEN_BUFFER_INFO
Dim dwSize As COORD
Dim dwCursorPosition As COORD
Dim wAttributes As Short
Dim srWindow As SMALL_RECT
Dim dwMaximumWindowSize As COORD
End Structure

Private Structure CHAR_INFO
Dim UnicodeChar As Short
Dim Attributes As Short
End Structure

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Integer) As Integer
Private Declare Function SetStdHandle Lib "kernel32" (ByVal nStdHandle As Integer, ByVal hHandle As Integer) As Integer
Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (ByVal hConsoleOutput As Integer, ByRef lpConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO) As Integer
Private Declare Function ReadConsoleOutputCharacter Lib "kernel32" Alias "ReadConsoleOutputCharacterA" (ByVal hConsoleOutput As Integer, ByVal lpCharacter As String, ByVal nLength As Integer, ByVal dwReadCoord As COORD, ByRef lpNumberOfCharsRead As Integer) As Integer
'Private Declare Function ScrollConsoleScreenBuffer Lib "kernel32" (ByVal hConsoleOutput As Integer, ByRef lpScrollRectangle As SMALL_RECT, ByRef lpClipRectangle As SMALL_RECT, ByVal dwDestinationOrigin As COORD, ByRef lpFill As CHAR_INFO) As Integer
Private Declare Function ScrollConsoleScreenBuffer Lib "kernel32" Alias "ScrollConsoleScreenBufferW" (ByVal hConsoleOutput As Integer, ByRef lpScrollRectangle As SMALL_RECT, ByVal lpClipRectangle As Integer, ByVal dwDestinationOrigin As COORD, ByRef lpFill As CHAR_INFO) As Integer
Private Declare Function SetConsoleCursorPosition Lib "kernel32" (ByVal hConsoleOutput As Integer, ByVal dwCursorPosition As COORD) As Integer
Private Declare Function SetConsoleCtrlHandler Lib "kernel32" (ByVal Handler As Integer, ByVal Add As Boolean) As Boolean

Private Const STD_OUTPUT_HANDLE As Integer = -11
Private Const STD_ERROR_HANDLE As Integer = -12

Public Shared Function Main(ByVal Arguments() As String) As Integer
Dim CommandLine As String = System.Environment.CommandLine
Dim FileName As String = ""
Dim n As Integer
For n = 1 To 2
  Dim Quoted As Boolean = False
  Dim k As Integer
  For k=0 To CommandLine.Length-1
    If CommandLine.Chars(k) = """" Then
      Quoted = Not Quoted
    ElseIf Not Quoted AndAlso CommandLine.Chars(k) = " " Then
      Exit For
    End If
  Next
  FileName = CommandLine.Substring(0,k).Replace("""","")
  CommandLine = CommandLine.Remove(0,k).Trim()
'  Console.Error.WriteLine("FileName:{0}",FileName)
'  Console.Error.WriteLine("Arguments:{0}",CommandLine)
Next
If FileName = "" Then FileName = "cmd"
Try
  Dim hConsoleOutput As Integer = GetStdHandle(STD_OUTPUT_HANDLE)
  Dim ConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO
  GetConsoleScreenBufferInfo(hConsoleOutput, ConsoleScreenBufferInfo)
  If ConsoleScreenBufferInfo.dwSize.x Then
    Console.WriteLine("Usage: ConCopyX [command_line] > file")
    Exit Function
  End If
  Dim hConsoleError As Integer = GetStdHandle(STD_ERROR_HANDLE)
  GetConsoleScreenBufferInfo(hConsoleError, ConsoleScreenBufferInfo)
'  Console.Error.WriteLine("dwsize ({0},{1})",ConsoleScreenBufferInfo.dwSize.x,ConsoleScreenBufferInfo.dwSize.y)
'  Console.Error.WriteLine("dwCursorPosition ({0},{1})",ConsoleScreenBufferInfo.dwCursorPosition.x,ConsoleScreenBufferInfo.dwCursorPosition.y)
  Dim y0 As Short = ConsoleScreenBufferInfo.dwCursorPosition.y
  If y0 > ConsoleScreenBufferInfo.dwSize.y \ 2 Then Scroll(hConsoleError, y0, ConsoleScreenBufferInfo)
  Dim oProcess As New Process()
  oProcess.StartInfo.FileName = FileName
  oProcess.StartInfo.Arguments = CommandLine
  oProcess.StartInfo.UseShellExecute = False
  SetStdHandle(STD_OUTPUT_HANDLE, hConsoleError)
  oProcess.Start()
  SetConsoleCtrlHandler(0, True)
  SetStdHandle(STD_OUTPUT_HANDLE, hConsoleOutput)
  Do
    GetConsoleScreenBufferInfo(hConsoleError, ConsoleScreenBufferInfo)
    If y0 = ConsoleScreenBufferInfo.dwCursorPosition.y Then
      If oProcess.HasExited Then Exit Do
      If y0 > ConsoleScreenBufferInfo.dwSize.y \ 2 Then Scroll(hConsoleError, y0, ConsoleScreenBufferInfo)
      Thread.Sleep(100)
    Else
      For y As Integer = y0 To ConsoleScreenBufferInfo.dwCursorPosition.y-1
        Dim ConsoleText As String = New String(vbNullChar, ConsoleScreenBufferInfo.dwSize.x)
        Dim nLength As Integer =  ConsoleScreenBufferInfo.dwSize.x
        Dim dwReadCoord As COORD
        dwReadCoord.x = 0
        dwReadCoord.y = y
        Dim NumberOfCharsRead As Integer
        ReadConsoleOutputCharacter(hConsoleError, ConsoleText, nLength, dwReadCoord, NumberOfCharsRead)
        Console.WriteLine(ConsoleText.TrimEnd(" "c,vbNullChar))
      Next
      y0 = ConsoleScreenBufferInfo.dwCursorPosition.y
    End If
  Loop
  System.Environment.Exit(oProcess.ExitCode)
Catch
  Console.Error.WriteLine("Source" & vbTab & vbTab & Err.Source & vbLf & "Number" & vbTab & vbTab & Err.Number & vbLf & "Description" & vbTab & Err.Description & vbLf & "DLL Error" & vbTab & vbTab & Err.LastDLLError)
  System.Environment.Exit(255)
End Try
End Function

Private Shared Sub Scroll(ByVal hConsoleError As Integer, ByRef y0 As Short, ByRef ConsoleScreenBufferInfo As CONSOLE_SCREEN_BUFFER_INFO)
Dim lpScrollRectangle As SMALL_RECT
lpScrollRectangle.Top = y0 - (ConsoleScreenBufferInfo.dwSize.y \ 2)
lpScrollRectangle.Left = 0
lpScrollRectangle.Right = ConsoleScreenBufferInfo.dwSize.x - 1
lpScrollRectangle.Bottom = ConsoleScreenBufferInfo.dwSize.y - 1
Dim dwDestinationOrigin As COORD
dwDestinationOrigin.x = 0
dwDestinationOrigin.y = 0
Dim lpFill As CHAR_INFO
lpFill.Attributes = ConsoleScreenBufferInfo.wAttributes
lpFill.UnicodeChar = 32
ScrollConsoleScreenBuffer(hConsoleError, lpScrollRectangle, 0, dwDestinationOrigin, lpFill)
y0 = ConsoleScreenBufferInfo.dwSize.y \ 2
Dim dwCursorPosition As COORD
dwCursorPosition.x = ConsoleScreenBufferInfo.dwCursorPosition.x
dwCursorPosition.y = y0
SetConsoleCursorPosition(hConsoleError, dwCursorPosition)
End Sub
End Class

ShellWindowsでWindows SearchのItem(n).Documentを見るとエラーになる。

Windows Searchを開いていると、Item(n).Documentを見るだけで、エラーになります。

エラー: クラスはオートメーションをサポートしていません。
コード: 800A01AE

この対処法は、エラーを拾ってもよいのですが、次でも迂回できます。

For Each ie In CreateObject("Shell.Application").Windows()
  If Right(ie.LocationName,17)=" - Windows Search" Then
    MsgBox "Windows Search"
  Else
    MsgBox TypeName(ie.Document)
  End If
Next

IE7の「リンク」バーからアプリを起動する。

エクスプローラの「リンク」バーからは、アプリを起動することができます。

しかし、IE7の「リンク」バーからアプリを起動しようとすると、まず、
「ファイルのダウンロード - セキュリティの警告」
「このファイルを開くか、または保存しますか？」
のダイアログが出て、さらに、
「Internet Explorer - セキュリティの警告」
「発行元が確認できませんでした。このソフトウェアを実行しますか？」
のダイアログが出ます。

これらを回避するには、

(1) デスクトップに、「リンク２」フォルダを作ります。
この中にアプリやアプリのショートカットを入れます。

(2) デスクトップで、「リンク２」をドラッグして、スタートメニューボタンにドロップします。
すると、スタートメニューの中に「リンク２」が追加されます。

(3) 「リンク」フォルダを開き、スタートメニューから「リンク２」をドラッグして、「リンク」フォルダにドロップします。
すると、「リンク」フォルダに「リンク２」の「フォルダショートカット」が移動します。

これで、IE7の「リンク」バーから「リンク２」のアプリが起動できるようになります。

バッチファイルからRunAsコマンドを使う。

RunAsコマンドは、パスワードをコンソールから入力しないと使えません。
なので、バッチファイルからは、RunAsコマンドが使えません。
しかし、KeyInコマンドを使えば、バッチファイルからRunAsコマンドが使えます。

start /b cmd /c sleep 3 ^& keyin password{CR}
runas /user:computer\user command

または、

start /b runas /user:computer\user command
sleep 3
keyin password{CR}

コンソール入力バッファにデータを書き込むコマンドをVB.NETで作る(その２)

使用法は、

KeyIn.exe 文字列

引数の文字列をそのまま、コンソール入力バッファに書き込みます。

コマンドプロンプトから、&|<>を引数に含めるときは、^でエスケープします。
改行を引数に含めるときは、{CR}で代替入力します。大小文字の区別あり。

バッチの中から、DOSKEYマクロを使うときは、

KeyIn.exe マクロ{CR}exit{CR}
cmd.exe

コンソール入力バッファにデータを書き込むコマンドをVB.NETで作る

コマンドプロンプトでは、コマンドを入力してエンターキーを押すまでは、コマンドラインが編集できます。
しかし、コマンドからコマンドラインを出力しても、それを直接、編集して実行することはできません。
また、バッチファイルの中からDOSKEYマクロを実行することはできません。
これらは、コマンドからコンソール入力バッファに書き込めば、可能です。

vbc KeyIn.VB

Public Class Class1

Private Structure KEY_EVENT_RECORD
Dim bKeyDown As Integer
Dim wRepeatCount As Short
Dim wVirtualKeyCode As Short
Dim wVirtualScanCode As Short
Dim UnicodeChar As UShort
Dim dwControlKeyState As Integer
End Structure

Private Structure INPUT_RECORD
Dim EventType As Short
Dim KeyEvent As KEY_EVENT_RECORD
End Structure

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Integer) As Integer
Private Declare Function WriteConsoleInput Lib "kernel32" Alias "WriteConsoleInputW" (ByVal hConsoleInput As Integer, ByVal lpBuffer() As INPUT_RECORD, ByVal nLength As Integer, ByRef lpNumberOfEventsWritten As Integer) As Integer

Private Const KEY_EVENT As Integer = 1s
Private Const STD_INPUT_HANDLE As Integer = -10

Public Shared Sub Main()
Dim CommandLine As String = System.Environment.CommandLine
Dim FileName As String = ""
Dim Quoted As Boolean = False
Dim k As Integer
For k=0 To CommandLine.Length-1
  If CommandLine.Chars(k) = """" Then
    Quoted = Not Quoted
  ElseIf Not Quoted AndAlso CommandLine.Chars(k) = " " Then
    Exit For
  End If
Next
FileName = CommandLine.Substring(0,k).Replace("""","")
CommandLine = CommandLine.Remove(0,k).Trim()
'Console.Error.WriteLine("FileName:{0}",FileName)
'Console.Error.WriteLine("Arguments:{0}",CommandLine)
KeyIn(CommandLine.Replace("{CR}",Chr(13)))
End Sub

Private Shared Sub KeyIn(s As String)
Dim lpBuffer() As INPUT_RECORD
Dim lpNumberOfEventsWritten As Integer
Dim hConsoleInput As Integer = GetStdHandle(STD_INPUT_HANDLE)
ReDim lpBuffer(Len(s)*2-1)
For k As Integer = 0 To UBound(lpBuffer)
  lpBuffer(k).EventType = KEY_EVENT
  lpBuffer(k).KeyEvent.bKeyDown = (k + 1) Mod 2
  lpBuffer(k).KeyEvent.wRepeatCount = 0
  lpBuffer(k).KeyEvent.wVirtualScanCode = 0
  lpBuffer(k).KeyEvent.wVirtualKeyCode = 0
  lpBuffer(k).KeyEvent.UnicodeChar = AscW(Mid(s,1 + (k \ 2),1))
  lpBuffer(k).KeyEvent.dwControlKeyState = 0
Next
WriteConsoleInput(hConsoleInput, lpBuffer, UBound(lpBuffer)+1, lpNumberOfEventsWritten)
End Sub
End Class