コンソールコマンドを実行して、そのコンソールログを採取するコマンドを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