如何把用VB进行控制台命令的输入和输出.

原创 2004年11月01日 18:06:00

以下是我做的代码,
-----------------------------------------------------模块代码----------------------------------------------

Attribute VB_Name = "DosIo"
'私有的数据结构申明
Private Type STARTUPINFO '(createprocess)
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Type PROCESS_INFORMATION '(creteprocess)
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadID As Long
End Type
Private Type SECURITY_ATTRIBUTES '(createprocess)
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
'常数声明
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const PROCESS_TERMINATE = &H1
Private Const PROCESS_QUERY_INFORMATION = &H400
'函数声明
Private Declare Function CreateProcessA Lib "kernel32" ( _
    ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As String, _
    lpProcessAttributes As SECURITY_ATTRIBUTES, _
    lpThreadAttributes As SECURITY_ATTRIBUTES, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    lpStartupInfo As STARTUPINFO, _
    lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" _
                          (ByVal hNamedPipe As Long, _
                           ByVal lpBuffer As Long, _
                           ByVal nBufferSize As Long, _
                           ByRef lpBytesRead As Long, _
                           ByRef lpTotalBytesAvail As Long, _
                           ByRef lpBytesLeftThisMessage As Long _
                           ) As Long

Private Declare Function CreatePipe Lib "kernel32" ( _
    phReadPipe As Long, _
    phWritePipe As Long, _
    lpPipeAttributes As Any, _
    ByVal nSize As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function ReadFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As Long, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Any) As Long

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hHandle As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
                                                   ByVal lpBuffer As Long, _
                                                   ByVal nNumberOfBytesToWrite As Long, _
                                                   ByRef lpNumberOfBytesWritten As Long, _
                                                   lpOverlapped As Any) As Long

Private Declare Function DuplicateHandle Lib "kernel32" _
               (ByVal hSourceProcessHandle As Long, _
                ByVal hSourceHandle As Long, _
                ByVal hTargetProcessHandle As Long, _
                lpTargetHandle As Long, _
                ByVal dwDesiredAccess As Long, _
                ByVal bInheritHandle As Long, _
                ByVal dwOptions As Long) As Long
 


Private Const DUPLICATE_SAME_ACCESS = &H2
Private PipeR4InputChannel As Long, PipeW4InputChannel As Long, hInputHandle As Long
Private PipeR4OutputChannel As Long, PipeW4OutputChannel As Long, hOutputHandle As Long
Private Proc As PROCESS_INFORMATION
Public Enum InitResult
  ERROR_OK = 0
  ERROR_INIT_INPUT_HANDLE = 1
  ERROR_INIT_OUTPUT_HANDLE = 2
  ERROR_DUP_READ_HANDLE = 3
  ERROR_DUP_WRITE_HANDLE = 4
  ERROR_CREATE_CHILD_PROCESS = 5
End Enum

Public Enum TermResult
 ERROR_OK = 0
End Enum
Public Enum InputResult
 ERROR_OK = 0
 ERROR_QUERY_WRITE_INFO_SIZE = 1
 ERROR_DATA_TO_LARGE = 2
 ERROR_WRITE_INFO = 3
 ERROR_WRITE_UNEXPECTED = 5
End Enum
Public Enum OutputResult
 ERROR_OK = 0
 ERROR_QUERY_READ_INFO_SIZE = 1
 ERROR_ZERO_INFO_SIZE = 2
 ERROR_READ_INFO = 3
 ERROR_UNEQUAL_INFO_SIZE = 4
 ERROR_READ_UNEXPECTED = 5
End Enum
Public Function InitDosIO() As InitResult
   Dim Sa As SECURITY_ATTRIBUTES, Ret As Long
  
   With Sa
      .nLength = Len(Sa)
      .bInheritHandle = 1&
      .lpSecurityDescriptor = 0&
   End With
   
    Ret = CreatePipe(PipeR4InputChannel, PipeW4InputChannel, Sa, 1024&)
    If Ret = 0 Then '建立进程输入管道
        InitDosIO = ERROR_INIT_INPUT_HANDLE
        Exit Function
    End If
   
    Ret = CreatePipe(PipeR4OutputChannel, PipeW4OutputChannel, Sa, 4096&) '建立输出通道,若建立失败,则关闭管道,退出
    If Ret = 0 Then '建立进程的输出管道
        CloseHandle PipeR4InputChannel
        CloseHandle PipeW4InputChannel
        InitDosIO = ERROR_INIT_OUTPUT_HANDLE
        Exit Function
    End If
  

   Ret = DuplicateHandle(GetCurrentProcess(), PipeW4InputChannel, GetCurrentProcess(), hInputHandle, 0, True, DUPLICATE_SAME_ACCESS)
   If Ret = 0 Then '转换写句柄
     CloseHandle PipeR4InputChannel
     CloseHandle PipeW4InputChannel
     CloseHandle PipeR4OutputChannel
     CloseHandle PipeW4OutputChannel
     InitDosIO = ERROR_DUP_WRITE_HANDLE
     Exit Function
   End If
   Ret = CloseHandle(PipeW4InputChannel)
   If Ret = 0 Then
    MsgBox "close handle eerr"
   End If
  Ret = DuplicateHandle(GetCurrentProcess(), PipeR4OutputChannel, GetCurrentProcess(), hOutputHandle, 0, True, DUPLICATE_SAME_ACCESS)
   If Ret = 0 Then '转换读句柄
     CloseHandle PipeR4InputChannel
     CloseHandle PipeW4InputChannel
     CloseHandle PipeR4OutputChannel
     CloseHandle PipeW4OutputChannel
     InitDosIO = ERROR_DUP_READ_HANDLE
     Exit Function
   End If
 Ret = CloseHandle(PipeR4OutputChannel)
 If Ret = 0 Then
  MsgBox "close handle 2 er"
 End If
  
   
    Dim Start As STARTUPINFO, CmdStr As String
    Start.cb = Len(Start)
    Start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
    Start.hStdOutput = PipeW4OutputChannel
    Start.hStdError = PipeW4OutputChannel
    Start.hStdInput = PipeR4InputChannel
    CmdStr = "CMD"
    Ret& = CreateProcessA(0&, CmdStr, Sa, Sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, Start, Proc)
   
    If Ret <> 1 Then '建立控制进程
        CloseHandle PipeR4InputChannel
        CloseHandle PipeW4InputChannel
        CloseHandle PipeR4OutputChannel
        CloseHandle PipeW4OutputChannel
        InitDosIO = ERROR_CREATE_CHILD_PROCESS
        Exit Function
    End If
   
End Function
Public Function DosInput(ByVal Str As String) As InputResult
 Dim Btarray  As String, Buflen As Long, BtWritten As Long, Rtn As Long
 Dim BtTest() As Byte
 Btarray = StrConv(Str + vbCrLf, vbFromUnicode)
 BtTest = StrConv(Str + vbCrLf, vbFromUnicode)
 Buflen = LenB(Btarray)
 Rtn = WriteFile(hInputHandle, StrPtr(BtTest), Buflen, BtWritten, ByVal 0&)
 
 If BtWritten = 0 Then
   DosInput = ERROR_WRITE_INFO
   Exit Function
 End If
 DosInput = 0
End Function

Public Function DosOutput(ByRef StrOutput As String) As OutputResult
  Dim Ret As Long, TmpBuf As String * 128, BtRead As Long, BtTotal As Long, BtLeft As Long
  Rtn = PeekNamedPipe(hOutputHandle, StrPtr(TmpBuf), 128, BtRead, BtTotal, BtLeft)
  If Rtn = 0 Then '查询信息量
    DosOutput = ERROR_QUERY_INFO_SIZE
    Exit Function
  End If
 
  If BtTotal = 0 Then '若信息为空,则退出
    DosOutput = ERROR_ZERO_INFO_SIZE
    Exit Function
  End If
 
  Dim Btbuf() As Byte, BtReaded As Long
  ReDim Btbuf(BtTotal)
  Ret = ReadFile(hOutputHandle, VarPtr(Btbuf(0)), BtTotal, lngbytesread, 0&)
 
  If Ret = 0 Then
    DosOutput = ERROR_READ_INFO
    Exit Function
  End If
  If BtTotal <> lngbytesread Then
   DosOutput = ERROR_UNEQUAL_INFO_SIZE
  End If
    
 Dim strBuf As String
 strBuf = StrConv(Btbuf, vbUnicode)
 Debug.Print strBuf
 StrOutput = strBuf
End Function
Public Function EndDosIo() As Long
 Dim Ret As Long
 CloseHandle PipeR4InputChannel
 CloseHandle PipeW4InputChannel
 CloseHandle PipeR4OutputChannel
 CloseHandle PipeW4OutputChannel
 CloseHandle Proc.hThread
 CloseHandle Proc.hProcess
If EndProcess(Proc.dwProcessId) = False Then
   MsgBox "主服务程序[CMD.EXE]没有关闭,请您手动关闭 ", vbInformation, "不好意思"
End If
End Function

Public Function EndProcess(ByVal ProcessID As Long) As Boolean
  Dim hProcess As Long, ExitCode As Long, Rst As Long
  hProcess = OpenProcess(PROCESS_TERMINATE Or PROCESS_QUERY_INFORMATION, True, ProcessID)
   If hProcess <> 0 Then
     GetExitCodeProcess hProcess, ExitCode
     If ExitCode <> 0 Then
       Rst = TerminateProcess(hProcess, ExitCode)
       CloseHandle hProcess
        If Rst = 0 Then

         EndProcess = False
        Else
         EndProcess = True
        End If
     Else
       EndProcess = False
     End If
   Else
     EndProcess = False
   End If
 
End Function
------------------------------------------------------窗体代码---------------------------------------
VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "控制台管道重定向 "
   ClientHeight    =   4620
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8820
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4620
   ScaleWidth      =   8820
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdget
      Caption         =   "获取控制台输出字符 "
      BeginProperty Font
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   1830
      TabIndex        =   4
      Top             =   4245
      Width           =   4575
   End
   Begin VB.CommandButton cmdExe
      Caption         =   "命令写入控制台"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   6720
      TabIndex        =   3
      Top             =   105
      Width           =   1800
   End
   Begin VB.TextBox TxtOutput
      BackColor       =   &H00404040&
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000005&
      Height          =   3615
      Left            =   0
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   540
      Width           =   8775
   End
   Begin VB.TextBox TxtExecute
      BackColor       =   &H00404040&
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   375
      Left            =   1320
      TabIndex        =   0
      Top             =   120
      Width           =   5295
   End
   Begin VB.Label Label1
      Caption         =   "命令输入:"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Cmdexe_Click()
 Dim Ret As Long, StrExe As String
 
 StrExe = TxtExecute.Text
 If Len(StrExe) = 0 Then
  MsgBox "命令怎么为空呢?", vbInformation, "奇怪?"
  Exit Sub
 End If
 
 Ret = DosInput(StrExe)
 
 If Ret <> 0 Then
  
   'MsgBox "在写入控制台管道的时候出现错误", vbInformation, "错误"
   Exit Sub
 End If
 sw False
End Sub

Private Sub Cmdget_Click()
  Dim strR As String
 Ret = DosOutput(strR)
 If Ret = 0 Then
  TxtOutput.Text = strR
 Else
  MsgBox "读取控制台输出错误", vbInformation, "错误"
 End If
 sw True
End Sub

Private Sub Form_Load()
 Dim Ret As Long
 Ret = InitDosIO()
 If Ret <> 0 Then
   MsgBox "控制台输入输出管道重定向初始化失败"
   End
 End If
 sw True
End Sub

Private Sub Form_Unload(Cancel As Integer)
 EndDosIo
End Sub
Private Sub sw(ByVal s As Boolean)
  cmdExe.Enabled = s
  cmdget.Enabled = Not s
End Sub
运行平台:2000/XP/稍微修改可用于98

VB.NET控制台程序程初学

vb。net
  • qq573223251
  • qq573223251
  • 2016年09月29日 11:51
  • 1120

vb如何 让程序暂停 几秒 再继续执行下面语句

在程序代码最上边加上 Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long) 在...
  • gaoxiang19820514
  • gaoxiang19820514
  • 2011年11月07日 11:13
  • 6310

浅谈重定向和转发(理论篇)

自己最近做项目的时候,发现当我由一个页面向另一个页面发送request请求的时候,发现在后台是拿不到这个请求数据的,自己就觉得很奇怪,明明已经向后台发送了数据,怎么会拿不到呢?   向同学询问,经同...
  • u010955843
  • u010955843
  • 2015年05月28日 15:44
  • 845

将CMD的输入输出重定向到自己的进程

    前段时间,CSDN VB版的一个网友问了一个如何取得进程句柄的问题,后来贴子中又引出另一个问题:如何将CMD的输入输出重定向到自己的进程?由于楼主提前结了贴子,所以我另开了一个贴子对这个问题作...
  • goodname008
  • goodname008
  • 2005年10月30日 18:54
  • 6883

VB/DELPHI 不使用管道和重定向方式获取SHELL输出内容

  • 2015年10月28日 02:49
  • 10KB
  • 下载

如何对CMD窗口进行输入输出重定向

昨天xingnup (黑猫)发了个贴子问关于如何取得进程句柄的问题。http://community.csdn.net/Expert/topic/4351/4351488.xml?temp=.4895...
  • winehero
  • winehero
  • 2005年12月31日 15:32
  • 2243

用VB编写基于控制台的程序

设计思路  (1)分配控制台程序的内存资源。  (2)设置控制台的相关属性。  (3)通过控制台输出文本内容。  (4)接收交互信息并继续输出。  (5)释放控制台程序的内存并关闭程序。实现步骤  (...
  • barenx
  • barenx
  • 2008年03月31日 22:09
  • 2035

VB完美模仿DOS命令行输出

  • 2009年12月16日 19:38
  • 7KB
  • 下载

VB中运行一个EXE文件,并对EXE窗口的控件进行操作

1,运行一个EXE程序  Dim   mProcID   As   LongmProcID   =   Shell(FileName) 2,把这个EXE程序关闭掉 Option   Explicit ...
  • smallboy_5
  • smallboy_5
  • 2008年10月07日 20:13
  • 5181

VB应用程序怎么获取命令行参数

iamlaosong文 用VB编写一个小工具,用来抓取网页信息。正常情况下网址是固定的,但有时需要改变,作为一个小工具,做个配置文件吧,用起来就不方便,因为EXE文件还得拖个配置文件,所以就想到用命令...
  • iamlaosong
  • iamlaosong
  • 2016年09月12日 11:48
  • 1253
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:如何把用VB进行控制台命令的输入和输出.
举报原因:
原因补充:

(最多只允许输入30个字)